Dateien an PC's senden und empfangen

[uoeb7gp]

Also eine Consolen Application für einen asynchronen Socket kann in etwa so aufgebaut werden.

Delphi-Quellcode:

program AsyncClientConsole;

  {$APPTYPE CONSOLE}

uses
  windows,
  SysUtils,
  messages,
  uConsoleClass in 'uConsoleClass.pas';

function MainWndProc(ahWnd: HWND; auMsg: Integer; wp: WPARAM;
  lp : LPARAM): Integer; stdcall; forward;

const
  WM_DATA      = WM_USER + 1;
  WM_CONNECTED = WM_USER + 2;
  WM_ERROR     = WM_USER + 3;

var
  Terminated    : Boolean;
  hWndMain      : HWND;

  TADAMainWindowClass : TWndClass = (style: 0; lpfnWndProc: @MainWndProc;
    cbClsExtra: 0; cbWndExtra: 0; hInstance: 0; hIcon: 0; hCursor: 0;
    hbrBackground: 0; lpszMenuName: nil; lpszClassName: 'MyConsoleMainWindowClass'
    );

procedure WMOnConnected(wp, lp: DWORD);
begin
  writeln('WMOnConnected : ' + PChar(wp));
end;

procedure WMOnData(wp, lp: DWORD);
begin
  writeln(PChar(wp));
  writeln(inttostr(lp));
end;

procedure WMOnError(wp, lp: DWORD);
begin
  writeln('WMOnECSError     : ' + PChar(wp));
end;

function MainWndProc(ahWnd: HWND; auMsg: Integer; wp: WPARAM;
  lp: LPARAM): Integer; stdcall;
begin
  Result := 0;

  if auMsg = WM_DATA then
    WMOnData(wp, lp)
  else if auMsg = WM_CONNECTED then
    WMOnConnected(wp, lp)
  else if auMsg = WM_ERROR then
    WMOnError(wp, lp)
  else if auMsg = WM_CLOSE then
    DestroyWindow(ahWnd)
  else
    Result := DefWindowProc(ahWnd, auMsg, wp, lp);

end;

function InitAplication : Boolean;
begin
  Result := FALSE;

  if Windows.RegisterClass(TADAMainWindowClass) = 0 then Exit;

  hWndMain := CreateWindowEx(WS_EX_TOOLWINDOW, TADAMainWindowClass.lpszClassName,
    '', WS_POPUP, 0, 0, 0, 0, 0, 0, HInstance, nil);

  if hWndMain = 0 then Exit;

  (******** Hier nun Socket Connection durchführen und
     Messaging mit Windowsmessages und oder mit Callback, je nach Geschmack
  ********)

  Result := TRUE;
end;


procedure CleanupAplication;
begin
  if hWndMain <> 0 then begin
    DestroyWindow(hWndMain);
    hWndMain := 0;
  end;
end;

procedure RunAplication;
var
  MsgRec : TMsg;
begin
  while GetMessage(MsgRec, 0, 0, 0) do begin
    TranslateMessage(MsgRec);
    DispatchMessage(MsgRec)
  end;
  Terminated := TRUE;
end;

begin
  InitAplication;
  try
    RunAplication;
  finally
    CleanupAplication;
  end;
end.