Oppure

Loading
13/02/22 6:42
MrCamarium
Ho comincaito a fare un po di ordine nel file server per intenderci il file installato sul PC remoto ho inserito le function:

[CODE]function Tipo_cpu: string;

var

aVendor: array[0..2] of DWord;

iI, iJ : Integer;

begin

asm

push ebx

xor eax, eax

dw $A20F // CPUID instruction

mov DWord ptr aVendor, ebx

mov DWord ptr aVendor[+4], edx

mov DWord ptr aVendor[+8], ecx

pop ebx

end;

for iI := 0 to 2 do

for iJ := 0 to 3 do

Result := Result + Chr((aVendor[iI] and (Ho comincaito a fare un po di ordine nel file server per intenderci il file installato sul PC remoto ho inserito le function:

[CODE]function Tipo_cpu: string;

var

aVendor: array[0..2] of DWord;

iI, iJ : Integer;

begin

asm

push ebx

xor eax, eax

dw $A20F // CPUID instruction

mov DWord ptr aVendor, ebx

mov DWord ptr aVendor[+4], edx

mov DWord ptr aVendor[+8], ecx

pop ebx

end;

for iI := 0 to 2 do

for iJ := 0 to 3 do

Result := Result + Chr((aVendor[iI] and ({parsed_message}0000FF shl (iJ * 8))) shr (iJ * 8));

end;



function GetCPUSpeed: Double;

const

DelayTime = 500;

var

TimerHi, TimerLo: DWORD;

PriorityClass, Priority: Integer;

begin

PriorityClass := GetPriorityClass(GetCurrentProcess);

Priority := GetThreadPriority(GetCurrentThread);

SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);

SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);

Sleep(10);

asm

dw 310Fh

mov TimerLo, eax

mov TimerHi, edx

end;

Sleep(DelayTime);

asm

dw 310Fh

sub eax, TimerLo

sbb edx, TimerHi

mov TimerLo, eax

mov TimerHi, edx

end;

SetThreadPriority(GetCurrentThread, Priority);

SetPriorityClass(GetCurrentProcess, PriorityClass);

Result := TimerLo / (1000 * DelayTime);

end;



function IsSoundCardInstalled: Boolean;

Begin

Result := waveOutGetNumDevs > 0;

End;



function InfoSO: String;

Var piattaforma: string;

win_ver: integer;

Begin

Case (Win32Platform) of VER_PLATFORM_WIN32_WINDOWS:

Begin

piattaforma := 'Windows 9x/Me';

win_ver := Win32BuildNumber AND {parsed_message}00FFFF;

End;

VER_PLATFORM_WIN32_NT:



Begin

piattaforma := 'Windows NT';

win_ver := Win32BuildNumber;

End;

Else

Begin

piattaforma := 'Windows';

win_ver := 0;

End;

End; // case

If (Win32CSDVersion = '') Then

InfoSO := Format('%s %d.%d (Build %d)', [piattaforma,Win32MajorVersion,

Win32MinorVersion,win_ver])

Else

InfoSO := Format('%s %d.%d (Build %d: %s)', [piattaforma,Win32MajorVersion,

Win32MinorVersion,win_ver,WIN32CSDVersion]);

End;



function SysComputerName: string;

var

I: DWord;

begin

I := MAX_COMPUTERNAME_LENGTH + 1;

SetLength(Result, I);

Windows.GetComputerName(PChar(Result), I);

Result := string(PChar(Result));

end;



function SysUserName: string;

var

I: DWord;

begin

I := 255;

SetLength(Result, I);

Windows.GetUserName(PChar(Result), I);

Result := string(PChar(Result));

end;[/CODE]

Adesso come faccio dal mio programma cioè il file cliente installato sulla mia macchina a richiamare le function?0000FF shl (iJ * 8))) shr (iJ * 8));

end;



function GetCPUSpeed: Double;

const

DelayTime = 500;

var

TimerHi, TimerLo: DWORD;

PriorityClass, Priority: Integer;

begin

PriorityClass := GetPriorityClass(GetCurrentProcess);

Priority := GetThreadPriority(GetCurrentThread);

SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);

SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);

Sleep(10);

asm

dw 310Fh

mov TimerLo, eax

mov TimerHi, edx

end;

Sleep(DelayTime);

asm

dw 310Fh

sub eax, TimerLo

sbb edx, TimerHi

mov TimerLo, eax

mov TimerHi, edx

end;

SetThreadPriority(GetCurrentThread, Priority);

SetPriorityClass(GetCurrentProcess, PriorityClass);

Result := TimerLo / (1000 * DelayTime);

end;



function IsSoundCardInstalled: Boolean;

Begin

Result := waveOutGetNumDevs > 0;

End;



function InfoSO: String;

Var piattaforma: string;

win_ver: integer;

Begin

Case (Win32Platform) of VER_PLATFORM_WIN32_WINDOWS:

Begin

piattaforma := 'Windows 9x/Me';

win_ver := Win32BuildNumber AND Ho comincaito a fare un po di ordine nel file server per intenderci il file installato sul PC remoto ho inserito le function:

[CODE]function Tipo_cpu: string;

var

aVendor: array[0..2] of DWord;

iI, iJ : Integer;

begin

asm

push ebx

xor eax, eax

dw $A20F // CPUID instruction

mov DWord ptr aVendor, ebx

mov DWord ptr aVendor[+4], edx

mov DWord ptr aVendor[+8], ecx

pop ebx

end;

for iI := 0 to 2 do

for iJ := 0 to 3 do

Result := Result + Chr((aVendor[iI] and ({parsed_message}0000FF shl (iJ * 8))) shr (iJ * 8));

end;



function GetCPUSpeed: Double;

const

DelayTime = 500;

var

TimerHi, TimerLo: DWORD;

PriorityClass, Priority: Integer;

begin

PriorityClass := GetPriorityClass(GetCurrentProcess);

Priority := GetThreadPriority(GetCurrentThread);

SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);

SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);

Sleep(10);

asm

dw 310Fh

mov TimerLo, eax

mov TimerHi, edx

end;

Sleep(DelayTime);

asm

dw 310Fh

sub eax, TimerLo

sbb edx, TimerHi

mov TimerLo, eax

mov TimerHi, edx

end;

SetThreadPriority(GetCurrentThread, Priority);

SetPriorityClass(GetCurrentProcess, PriorityClass);

Result := TimerLo / (1000 * DelayTime);

end;



function IsSoundCardInstalled: Boolean;

Begin

Result := waveOutGetNumDevs > 0;

End;



function InfoSO: String;

Var piattaforma: string;

win_ver: integer;

Begin

Case (Win32Platform) of VER_PLATFORM_WIN32_WINDOWS:

Begin

piattaforma := 'Windows 9x/Me';

win_ver := Win32BuildNumber AND {parsed_message}00FFFF;

End;

VER_PLATFORM_WIN32_NT:



Begin

piattaforma := 'Windows NT';

win_ver := Win32BuildNumber;

End;

Else

Begin

piattaforma := 'Windows';

win_ver := 0;

End;

End; // case

If (Win32CSDVersion = '') Then

InfoSO := Format('%s %d.%d (Build %d)', [piattaforma,Win32MajorVersion,

Win32MinorVersion,win_ver])

Else

InfoSO := Format('%s %d.%d (Build %d: %s)', [piattaforma,Win32MajorVersion,

Win32MinorVersion,win_ver,WIN32CSDVersion]);

End;



function SysComputerName: string;

var

I: DWord;

begin

I := MAX_COMPUTERNAME_LENGTH + 1;

SetLength(Result, I);

Windows.GetComputerName(PChar(Result), I);

Result := string(PChar(Result));

end;



function SysUserName: string;

var

I: DWord;

begin

I := 255;

SetLength(Result, I);

Windows.GetUserName(PChar(Result), I);

Result := string(PChar(Result));

end;[/CODE]

Adesso come faccio dal mio programma cioè il file cliente installato sulla mia macchina a richiamare le function?00FFFF;

End;

VER_PLATFORM_WIN32_NT:



Begin

piattaforma := 'Windows NT';

win_ver := Win32BuildNumber;

End;

Else

Begin

piattaforma := 'Windows';

win_ver := 0;

End;

End; // case

If (Win32CSDVersion = '') Then

InfoSO := Format('%s %d.%d (Build %d)', [piattaforma,Win32MajorVersion,

Win32MinorVersion,win_ver])

Else

InfoSO := Format('%s %d.%d (Build %d: %s)', [piattaforma,Win32MajorVersion,

Win32MinorVersion,win_ver,WIN32CSDVersion]);

End;



function SysComputerName: string;

var

I: DWord;

begin

I := MAX_COMPUTERNAME_LENGTH + 1;

SetLength(Result, I);

Windows.GetComputerName(PChar(Result), I);

Result := string(PChar(Result));

end;



function SysUserName: string;

var

I: DWord;

begin

I := 255;

SetLength(Result, I);

Windows.GetUserName(PChar(Result), I);

Result := string(PChar(Result));

end;[/CODE]

Adesso come faccio dal mio programma cioè il file cliente installato sulla mia macchina a richiamare le function?
aaa
13/02/22 7:37
nessuno
Non si capisce niente
Ricorda che nessuno è obbligato a risponderti e che nessuno è perfetto ...
---
Il grande studioso italiano Bruno de Finetti ( uno dei padri fondatori del moderno Calcolo delle probabilità ) chiamava il gioco del Lotto Tassa sulla stupidità.
16/02/22 20:31
MrCamarium
Ho un problema su questo codice: 
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdIOHandler, IdGlobal, StdCtrls, IdStack;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Button2: TButton;
    client: TIdTCPClient;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  client: TIdTCPClient;

implementation

{$R *.dfm}

function Tipo_cpu: string;
    var
      aVendor: array[0..2] of DWord;
      iI, iJ : Integer;
    begin
      asm
        push ebx
        xor   eax, eax
        dw    $A20F // CPUID instruction
        mov   DWord ptr aVendor, ebx
        mov   DWord ptr aVendor[+4], edx
        mov   DWord ptr aVendor[+8], ecx
        pop   ebx
      end;
      for iI := 0 to 2 do
        for iJ := 0 to 3 do
        Result := Result + Chr((aVendor[iI] and (Ho un problema su questo codice:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdIOHandler, IdGlobal, StdCtrls, IdStack;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Button2: TButton;
    client: TIdTCPClient;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  client: TIdTCPClient;

implementation

{$R *.dfm}

function Tipo_cpu: string;
    var
      aVendor: array[0..2] of DWord;
      iI, iJ : Integer;
    begin
      asm
        push ebx
        xor   eax, eax
        dw    $A20F // CPUID instruction
        mov   DWord ptr aVendor, ebx
        mov   DWord ptr aVendor[+4], edx
        mov   DWord ptr aVendor[+8], ecx
        pop   ebx
      end;
      for iI := 0 to 2 do
        for iJ := 0 to 3 do
        Result := Result + Chr((aVendor[iI] and ({parsed_message}0000FF shl (iJ * 8))) shr (iJ * 8));
    end;

function GetCPUSpeed: Double;
const
  DelayTime = 500;
var
  TimerHi, TimerLo: DWORD;
  PriorityClass, Priority: Integer;
begin
  PriorityClass := GetPriorityClass(GetCurrentProcess);
  Priority      := GetThreadPriority(GetCurrentThread);
  SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
  Sleep(10);
  asm
    dw 310Fh
    mov TimerLo, eax
    mov TimerHi, edx
  end;
  Sleep(DelayTime);
  asm
    dw 310Fh
    sub eax, TimerLo
    sbb edx, TimerHi
    mov TimerLo, eax
    mov TimerHi, edx
  end;
  SetThreadPriority(GetCurrentThread, Priority);
  SetPriorityClass(GetCurrentProcess, PriorityClass);
  Result := TimerLo / (1000 * DelayTime);
end;

function InfoSO: String;
Var piattaforma: string;
       win_ver: integer;
Begin
 Case (Win32Platform) of VER_PLATFORM_WIN32_WINDOWS:
  Begin
    piattaforma := 'Windows 9x/Me';
    win_ver := Win32BuildNumber AND {parsed_message}00FFFF;
 End;
 VER_PLATFORM_WIN32_NT:

   Begin
    piattaforma := 'Windows NT';
    win_ver := Win32BuildNumber;
   End;
 Else
  Begin
   piattaforma := 'Windows';
   win_ver := 0;
  End;
 End; // case
If (Win32CSDVersion = '') Then
    InfoSO := Format('%s %d.%d (Build %d)', [piattaforma,Win32MajorVersion,
                                  Win32MinorVersion,win_ver])
 Else
    InfoSO := Format('%s %d.%d (Build %d: %s)', [piattaforma,Win32MajorVersion,
                               Win32MinorVersion,win_ver,WIN32CSDVersion]);
End;

function SysComputerName: string;
var
  I: DWord;
begin
  I := MAX_COMPUTERNAME_LENGTH + 1;
  SetLength(Result, I);
  Windows.GetComputerName(PChar(Result), I);
  Result := string(PChar(Result));
end;

function SysUserName: string;
var
  I: DWord;
begin
  I := 255;
  SetLength(Result, I);
  Windows.GetUserName(PChar(Result), I);
  Result := string(PChar(Result));
end;

function ReadMessage(io: TIdIOHandler; var kind: Byte) : TIdBytes;
var
  len: UInt32;
begin
  len := io.ReadLongWord();
  kind := io.ReadByte;
  SetLength(Result, len);
  io.ReadBytes(Result, len, False);
end;

function BytesToStr(b: TIdBytes): string;
begin
  Result := TEncoding.UTF8.GetString(b);
end;

function StrToBytes(s: string) : TIdBytes;
var
  b: TBytes;
  len: Integer;
begin
  b := TEncoding.UTF8.GetBytes(s);
  len := Length(b);
  SetLength(Result, len);
  CopyMemory(Result, b, len);
end;

function HandleResponse(h: TIdIOHandler): Boolean;
begin
  result:= FALSE;
end;

function WaitForCommand(args: Pointer): Cardinal; stdcall;
begin
    while client.Connected do
        if not HandleResponse(client.IOHandler) then
            break;
    Result := 0;
end;

procedure WriteMessage(io: TIdIOHandler; kind: Byte; msg: TIdBytes);
var
  len: UInt32;
begin
  len := Length(msg);
  io.Write(len);
  io.Write(kind);
  io.Write(msg);
end;

procedure SendHello(io: TIdIOHandler);
var
  cpu: string;
  so: string;
  username: string;
  pcname: string;
  hello: string;
begin
  cpu := Tipo_cpu;
  so := InfoSO;
  username := SysUserName;
  pcname := SysComputerName;
  hello := cpu + '|' + so + '|' + username + '|' + pcname;
  WriteMessage(io, 1, StrToBytes(hello));
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  client: TIdTCPClient;
begin
  client := TIdTCPClient.Create;
  client.Port := 2630;
  client.Host := '127.0.0.1';
  client.ReadTimeout := 10000;
  client.Connect;
  Label1.Caption := 'Connesso'
  end;

procedure TForm1.Button2Click(Sender: TObject);
var
    dwThread: Cardinal;
begin
    SendHello(client.IOHandler);
    CreateThread(nil, 0, @WaitForCommand, nil, 0, dwThread);
end;

end.





Quando clicco sul bottone 2 mi restituisce una finestra con un errore di memoria.0000FF shl (iJ * 8))) shr (iJ * 8));
    end;

function GetCPUSpeed: Double;
const
  DelayTime = 500;
var
  TimerHi, TimerLo: DWORD;
  PriorityClass, Priority: Integer;
begin
  PriorityClass := GetPriorityClass(GetCurrentProcess);
  Priority      := GetThreadPriority(GetCurrentThread);
  SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
  Sleep(10);
  asm
    dw 310Fh
    mov TimerLo, eax
    mov TimerHi, edx
  end;
  Sleep(DelayTime);
  asm
    dw 310Fh
    sub eax, TimerLo
    sbb edx, TimerHi
    mov TimerLo, eax
    mov TimerHi, edx
  end;
  SetThreadPriority(GetCurrentThread, Priority);
  SetPriorityClass(GetCurrentProcess, PriorityClass);
  Result := TimerLo / (1000 * DelayTime);
end;

function InfoSO: String;
Var piattaforma: string;
       win_ver: integer;
Begin
 Case (Win32Platform) of VER_PLATFORM_WIN32_WINDOWS:
  Begin
    piattaforma := 'Windows 9x/Me';
    win_ver := Win32BuildNumber AND Ho un problema su questo codice:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdIOHandler, IdGlobal, StdCtrls, IdStack;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Button2: TButton;
    client: TIdTCPClient;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  client: TIdTCPClient;

implementation

{$R *.dfm}

function Tipo_cpu: string;
    var
      aVendor: array[0..2] of DWord;
      iI, iJ : Integer;
    begin
      asm
        push ebx
        xor   eax, eax
        dw    $A20F // CPUID instruction
        mov   DWord ptr aVendor, ebx
        mov   DWord ptr aVendor[+4], edx
        mov   DWord ptr aVendor[+8], ecx
        pop   ebx
      end;
      for iI := 0 to 2 do
        for iJ := 0 to 3 do
        Result := Result + Chr((aVendor[iI] and ({parsed_message}0000FF shl (iJ * 8))) shr (iJ * 8));
    end;

function GetCPUSpeed: Double;
const
  DelayTime = 500;
var
  TimerHi, TimerLo: DWORD;
  PriorityClass, Priority: Integer;
begin
  PriorityClass := GetPriorityClass(GetCurrentProcess);
  Priority      := GetThreadPriority(GetCurrentThread);
  SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
  Sleep(10);
  asm
    dw 310Fh
    mov TimerLo, eax
    mov TimerHi, edx
  end;
  Sleep(DelayTime);
  asm
    dw 310Fh
    sub eax, TimerLo
    sbb edx, TimerHi
    mov TimerLo, eax
    mov TimerHi, edx
  end;
  SetThreadPriority(GetCurrentThread, Priority);
  SetPriorityClass(GetCurrentProcess, PriorityClass);
  Result := TimerLo / (1000 * DelayTime);
end;

function InfoSO: String;
Var piattaforma: string;
       win_ver: integer;
Begin
 Case (Win32Platform) of VER_PLATFORM_WIN32_WINDOWS:
  Begin
    piattaforma := 'Windows 9x/Me';
    win_ver := Win32BuildNumber AND {parsed_message}00FFFF;
 End;
 VER_PLATFORM_WIN32_NT:

   Begin
    piattaforma := 'Windows NT';
    win_ver := Win32BuildNumber;
   End;
 Else
  Begin
   piattaforma := 'Windows';
   win_ver := 0;
  End;
 End; // case
If (Win32CSDVersion = '') Then
    InfoSO := Format('%s %d.%d (Build %d)', [piattaforma,Win32MajorVersion,
                                  Win32MinorVersion,win_ver])
 Else
    InfoSO := Format('%s %d.%d (Build %d: %s)', [piattaforma,Win32MajorVersion,
                               Win32MinorVersion,win_ver,WIN32CSDVersion]);
End;

function SysComputerName: string;
var
  I: DWord;
begin
  I := MAX_COMPUTERNAME_LENGTH + 1;
  SetLength(Result, I);
  Windows.GetComputerName(PChar(Result), I);
  Result := string(PChar(Result));
end;

function SysUserName: string;
var
  I: DWord;
begin
  I := 255;
  SetLength(Result, I);
  Windows.GetUserName(PChar(Result), I);
  Result := string(PChar(Result));
end;

function ReadMessage(io: TIdIOHandler; var kind: Byte) : TIdBytes;
var
  len: UInt32;
begin
  len := io.ReadLongWord();
  kind := io.ReadByte;
  SetLength(Result, len);
  io.ReadBytes(Result, len, False);
end;

function BytesToStr(b: TIdBytes): string;
begin
  Result := TEncoding.UTF8.GetString(b);
end;

function StrToBytes(s: string) : TIdBytes;
var
  b: TBytes;
  len: Integer;
begin
  b := TEncoding.UTF8.GetBytes(s);
  len := Length(b);
  SetLength(Result, len);
  CopyMemory(Result, b, len);
end;

function HandleResponse(h: TIdIOHandler): Boolean;
begin
  result:= FALSE;
end;

function WaitForCommand(args: Pointer): Cardinal; stdcall;
begin
    while client.Connected do
        if not HandleResponse(client.IOHandler) then
            break;
    Result := 0;
end;

procedure WriteMessage(io: TIdIOHandler; kind: Byte; msg: TIdBytes);
var
  len: UInt32;
begin
  len := Length(msg);
  io.Write(len);
  io.Write(kind);
  io.Write(msg);
end;

procedure SendHello(io: TIdIOHandler);
var
  cpu: string;
  so: string;
  username: string;
  pcname: string;
  hello: string;
begin
  cpu := Tipo_cpu;
  so := InfoSO;
  username := SysUserName;
  pcname := SysComputerName;
  hello := cpu + '|' + so + '|' + username + '|' + pcname;
  WriteMessage(io, 1, StrToBytes(hello));
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  client: TIdTCPClient;
begin
  client := TIdTCPClient.Create;
  client.Port := 2630;
  client.Host := '127.0.0.1';
  client.ReadTimeout := 10000;
  client.Connect;
  Label1.Caption := 'Connesso'
  end;

procedure TForm1.Button2Click(Sender: TObject);
var
    dwThread: Cardinal;
begin
    SendHello(client.IOHandler);
    CreateThread(nil, 0, @WaitForCommand, nil, 0, dwThread);
end;

end.





Quando clicco sul bottone 2 mi restituisce una finestra con un errore di memoria.00FFFF;
 End;
 VER_PLATFORM_WIN32_NT:

   Begin
    piattaforma := 'Windows NT';
    win_ver := Win32BuildNumber;
   End;
 Else
  Begin
   piattaforma := 'Windows';
   win_ver := 0;
  End;
 End; // case
If (Win32CSDVersion = '') Then
    InfoSO := Format('%s %d.%d (Build %d)', [piattaforma,Win32MajorVersion,
                                  Win32MinorVersion,win_ver])
 Else
    InfoSO := Format('%s %d.%d (Build %d: %s)', [piattaforma,Win32MajorVersion,
                               Win32MinorVersion,win_ver,WIN32CSDVersion]);
End;

function SysComputerName: string;
var
  I: DWord;
begin
  I := MAX_COMPUTERNAME_LENGTH + 1;
  SetLength(Result, I);
  Windows.GetComputerName(PChar(Result), I);
  Result := string(PChar(Result));
end;

function SysUserName: string;
var
  I: DWord;
begin
  I := 255;
  SetLength(Result, I);
  Windows.GetUserName(PChar(Result), I);
  Result := string(PChar(Result));
end;

function ReadMessage(io: TIdIOHandler; var kind: Byte) : TIdBytes;
var
  len: UInt32;
begin
  len := io.ReadLongWord();
  kind := io.ReadByte;
  SetLength(Result, len);
  io.ReadBytes(Result, len, False);
end;

function BytesToStr(b: TIdBytes): string;
begin
  Result := TEncoding.UTF8.GetString(b);
end;

function StrToBytes(s: string) : TIdBytes;
var
  b: TBytes;
  len: Integer;
begin
  b := TEncoding.UTF8.GetBytes(s);
  len := Length(b);
  SetLength(Result, len);
  CopyMemory(Result, b, len);
end;

function HandleResponse(h: TIdIOHandler): Boolean;
begin
  result:= FALSE;
end;

function WaitForCommand(args: Pointer): Cardinal; stdcall;
begin
    while client.Connected do
        if not HandleResponse(client.IOHandler) then
            break;
    Result := 0;
end;

procedure WriteMessage(io: TIdIOHandler; kind: Byte; msg: TIdBytes);
var
  len: UInt32;
begin
  len := Length(msg);
  io.Write(len);
  io.Write(kind);
  io.Write(msg);
end;

procedure SendHello(io: TIdIOHandler);
var
  cpu: string;
  so: string;
  username: string;
  pcname: string;
  hello: string;
begin
  cpu := Tipo_cpu;
  so := InfoSO;
  username := SysUserName;
  pcname := SysComputerName;
  hello := cpu + '|' + so + '|' + username + '|' + pcname;
  WriteMessage(io, 1, StrToBytes(hello));
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  client: TIdTCPClient;
begin
  client := TIdTCPClient.Create;
  client.Port := 2630;
  client.Host := '127.0.0.1';
  client.ReadTimeout := 10000;
  client.Connect;
  Label1.Caption := 'Connesso'
  end;

procedure TForm1.Button2Click(Sender: TObject);
var
    dwThread: Cardinal;
begin
    SendHello(client.IOHandler);
    CreateThread(nil, 0, @WaitForCommand, nil, 0, dwThread);
end;

end.


Quando clicco sul bottone 2 mi restituisce una finestra con un errore di memoria.
Ultima modifica effettuata da MrCamarium 24/02/22 10:37
aaa