Arsip: TServerSocket

 
user image
more 17 years ago

cikumiyu

Langsung saja ya. Begini: Saya sedang membuat prototipe untuk sebuah server MMOG. Prototipe yang saya buat menggunakan object pascal. Sengaja saya coba buat menjadi aplikasi konsol. Setelah membuat beberapa class untuk server dan client, saya kemudian mencoba untuk menjalankan kedua modul tersebut (client dan server) untuk melihat apakan mereka dapat berkomunikasi. Oh ya, komunikasi antara server dan client melalui socket. untuk server, saya menggunakan class TServerSocket dan untuk client menggunakan TClientSocket. Setelah dicoba, tenyata mereka gagal untu berkomunikasi. Server tahu jika ada client yang mencoba membuat membangun koneksi (connection establishment) ke server. Tapi anehnya, ketika client mengirimkan pesan, server tidak bisa menangkap/menerima pesan yang dikirimkan oleh client. Dengan kata lain, TEngineCore.OnClientReadHandler(ASocket: TCustomWinSocket) tidak dipanggil ketika client selesai mengirimkan pesan. Setelah di debug, ternyata kesalahan memang ada di server. Seperti yang telah di sebutnkan di atas, server memang tidak menerima pesan yang dikirimkan client. Server didak menerima BUKAN karena client tidak mengirim. Tapi memang karena server tidak mendengar pesan yang dikirim client. Bisa dipastikan demikian karena setelah kedua modul ditranslate menjadi aplikasi GUI, komunikasi berjalan tanpa masalah. Source codenya adalah seperti ini: file Server.dpr:
program Server;
{$APPTYPE CONSOLE}
uses
  SysUtils,
  EngineCore in 'EngineCore.pas',
  Communication in 'Communication.pas';
var
  engine: TEngineCore;
begin
  engine := TEngineCore.Create;
  engin.Initialize;
  engine.Run;
  engine.Terminate;
end.
file EngineCore.pas:
unit EngineCore;
interface
uses Communication, ScktComp;
const
  SERVER_PORT = 9000;
type
  TEngineCore = class
  private
    FCommunication: TCommunication;
    FNumberOfClient: Integer;
    procedure OnClientConnectedHandler(ASocket: TCustomWinSocket);
    procedure OnClientReadHandler(ASocket: TCustomWinSocket); 	
  public
    constructor Create;
    procedure Initialize;
    procedure Run;
    procedure Terminate;
  end;
implementation
{TEngineCore}
procedure TEngineCore.OnClientConnectedHandler(ASocket: TCustomWinSocket);
begin
  Inc(FNumberOfClient);
  Writeln(FNumberOfClient, ' has connected to server.');
end;
procedure TEngineCore.OnClientReadHandler(ASocket: TCustomWinSocket);
begin
  Writeln('Message from Client: ', ASocket.ReceiveText);
end;
constructor TEngineCore.Create;
begin
  FNumberOfClient := 0;
end; 
procedure TEngineCore.Initialize;
begin
  FCommunication := TCommunication.Create;
  FCommunication.Port := SERVER_PORT;
  FCommunication.OnClientConnected := OnClientConnectedHandler;
  FCommunication.OnClientRead := OnClientReadHandler;
  FCommunication.Active := True;
end;
procedure TEngineCore.Run;
begin
  while True do 
  begin
    { Server main operations. }
  end;
end;
procedure TEngineCore.Terminate;
begin
  FCommunication.Free;
end;
end.
file Communication.pas:
unit Communication;
interface
uses ScktComp;
type
  TOnClientConnected = procedure(ASocket: TCustomWinSocket) of object;
  TOnClientRead = procedure(ASocket: TCustomWinSocket) of object;
  TCommunication = class
  private
    FSocket: TServerSocket;
    FOnClientConnected: TOnClientConnected;
    FonClientRead: TOnClientRead;
    FPort: Integer;
    FActive: Boolean;
    procedure SetPort(AValue: Integer);
    procedure SetActive(AValue: Boolean);
    procedure OnAcceptHandler(Sender: TObject; Socket: TCustomWinSocket);
    procedure OnClientReadHandler(Sender: TObject; Socket: TCustomWinSocket);
  public
    constructor Create;
    destructor Destroy; override;
    property Port: Integer read FPort write SetPort;
    property Active: Boolean read FActive write SetActive;    
    property OnClientConnected: TOnClientConnected read FOnClientConnected write FOnClientConnected;
    property OnClientRead: TOnClientRead read FonClientRead write FOnClientRead;
  end;
implementation
{TCommunication}
procedure TCommunication.SetPort(AValue: Integer);
begin
  if FSocket <> nil then 
  begin
    FPort := AValue;
    FSocket.Port := FPort;
  end;
end;
procedure TCommunication.SetActive(AValue: Boolean);
begin
  if FSocket <> nil then 
  begin
    FActive := AValue;
    FSocket.Active := FActive;
  end;
end;
procedure TCommunication.OnAcceptHandler(Sender: TObject; Socket: TCustomWinSocket);
begin
  if Assigned(FOnClientConnected) then 
  begin	
    FOnClientConnected(Socket);
  end;	
end;
procedure TCommunication.OnClientReadHandler(Sender: TObject; Socket: TCustomWinSocket);
begin
  if Assigned(FonClientRead) then 
  begin	
    FonClientRead(Socket);
  end;	
end;
constructor TCommunication.Create;
begin
  Fsocket := TServerSocket.Create(nil);
  FSocket.OnAccept := OnAcceptHandler;
  FSocket.OnClientRead := OnClientReadHandler;
end;
destructor TCommunication.Destroy;
begin
  FSocket.Free;
  inherited;
end;
end.
Nah, seperti itulah source code-nya. Kira-kira letak kesalahannya di mana ya. Oh ya, mohon maaf kalau ada compiling error. Harap maklum, saya ngetiknya ngga pakai IDE karena di komputer yang lagi dipakai buat posting ngga ada IDE Delphi. Sebelumnya terima kasih.
user image
more 17 years ago

danieljun

rajin bener ya pakai serversocket, emang kalau pakai Indy gak bisa ya? terlalu berat?
user image
more 17 years ago

cikumiyu

@danieljun: rajin bener ya pakai serversocket, emang kalau pakai Indy gak bisa ya? terlalu berat?
Bukan masalah berat apa ngga. Cuman kebetulan pengen pake TServerSocket, dan kebetulan juga dapet kasus seperti itu. :D:D
user image
more 17 years ago

mat_koder

sebaiknya untuk socket programming di console application pake mode non blocking (synchronous) dikombinasikan dengan multithreading. non blocking lebih handal untuk menghandle client yg jumlahnya banyak. Pake TserverSocket bisa tapi ada beberapa hal yg hrs anda ketahui lebih dulu mengenai non blocking operationnnya ( baca help ). klo mau mudah pake aja synapse. -
user image
more 17 years ago

mat_koder

sori salah nulis.... synchronous berarti blocking ... ( ServerSocket.ServerType = stThreadBlocking )
user image
more 17 years ago

mat_koder

berikut adalah potongan kode yg pernah saya buat ini adalah kode dalam aplikasi Service ( shg ngga bisa make window/form sebagai media message pump utk socket dalam metoda non-blocking / asynchronous) Ini menjelaskan peroalan anda: ServerSocket (non-blocking mode) jalan di GUI tapi ngga jalan di console. ServerSocket di inisialisasikan di DataModule sebagai mode blocking. ( :D tentunya banyak kode-kode di class TFileTransferServerThread yg tidak relevan dengan permasalahan anda :D )

.........
.........
  TFileTransferServerThread = class(TServerClientThread)
  private
    cmd: TSharedVars;
    fBuffer: array of Char;
    fSocketStream: TWinSocketStream;
    fFileName: string;
    fFileHandle: integer;
    fData, lData, fSendString: string;
    fFileSize: integer;
    function ProcessReceiveVideoFile: Boolean;
    function ProcessReceiveBackupFile: Boolean;
    function ProcessSendTheFile: Boolean;
    function ProcessSendFileInfo: Boolean;
    function ProcessSendFile: Boolean;
    function ReceiveAndWriteTheData: Boolean;
    function ProcessRenameVideoFile: Boolean;
    function ProcessDataFileListing: Boolean;
  public
    constructor Create(CreateSuspended: Boolean; ASocket:
      TServerClientWinSocket);
    destructor Destroy; override;
    procedure ClientExecute; override;
  end;

implementation
procedure TMyModule.DataModuleCreate(Sender: TObject);
begin
  ServerSocket := TServerSocket.Create(nil);
  ServerSocket.ServerType := stThreadBlocking;
  ServerSocket.Port := SERVERVIDEOTRANSFERSOCKETPORT;
  ServerSocket.OnGetThread =  ServerSocketNewClientThread;
  ServerSocket.Open;
end;

procedure TMyModule.ServerSocketNewClientThread(Sender: TObject;
  ClientSocket: TServerClientWinSocket;
  var SocketThread: TServerClientThread);
begin
  SocketThread := TFileTransferServerThread.Create(TRUE, ClientSocket);
end;


{ TFileTransferServerThread }
procedure TFileTransferServerThread.ClientExecute;
var
  s: string;
  len: integer;
begin
  try
    fFileSize := 0;
    fData := '';
    fSocketStream := TWinSocketStream.Create(ClientSocket, 80000);
    while fSocketStream.WaitForData(60000) do
    begin
      SetLength(lData, SOCKETBUFFERSIZE);
      len := fSocketStream.Read(lData[1], SOCKETBUFFERSIZE);
      if len = 0 then
        exit;
      SetLength(lData, len);
      if len > 0 then
      begin
        fData := fData + lData;
        if Pos(TRANSFER_TOKEN, fData) > 0 then
        begin
          if Pos(SENDING_VIDEOFILE_TOKEN, fData) > 0 then
            ProcessReceiveVideoFile;
          if Pos(SENDING_BACKUPFILE_TOKEN, fData) > 0 then
            ProcessReceiveBackupFile;
          if Pos(REQUEST_FILEINFO_TOKEN, fData) > 0 then
            ProcessSendFileInfo;
          if Pos(REQUEST_FILETRANSFER_TOKEN, fData) > 0 then
            ProcessSendFile;
          if Pos(REQUEST_RENAMEVIDEOFILE_TOKEN, fData) > 0 then
            ProcessRenameVideoFile;
          if Pos(REQUEST_DATAFILELISTING_TOKEN, fData) > 0 then
            ProcessDataFileListing;
          exit;
        end;
      end;
    end;
    ClientSocket.Close;
  finally
    Terminate;
  end;
end;
constructor TFileTransferServerThread.Create(CreateSuspended: Boolean;
  ASocket: TServerClientWinSocket);
begin
  inherited Create(TRUE, ASocket);
  FreeOnTerminate := True;
  Priority := tpLower;
  fSocketStream := nil;
  fFileHandle := -1;
  cmd := TSharedVars.Create;
  Resume;
end;
destructor TFileTransferServerThread.Destroy;
begin
  try
    if Assigned(fSocketStream) then
      FreeAndNil(fSocketStream);
    if fFileHandle > 0 then
      FileClose(fFileHandle);
    fFileHandle := -1;
  except
  end;
  try
    FreeAndNil(cmd);
  except
  end;
  inherited;
end;
function TFileTransferServerThread.ReceiveAndWriteTheData: Boolean;
var
  p, len, recvlen: integer;
  tim: DWORD;
begin
  result := False;
  recvlen := 0;
  try
    if Pos(AppDrive, fFileName) <> 1 then
    begin
      Delete(fFileName, 1, Pos(':', fFileName));
      fFileNAme := AppDrive + fFileName;
    end;
    fFileHandle := FileOpen(fFileName, fmOpenReadWrite or fmShareExclusive);
    if fFileHandle < 0 then
      fFileHandle := FileCreate(fFileName);
    if fFileHandle = -1 then
      exit;
    // tunggu data file yg dikirim oleh client
    while fSocketStream.WaitForData(60000) do
    begin
      len := fSocketStream.Read(fBuffer, SOCKETBUFFERSIZE);
      if len = 0 then
        exit;
      RecvLen := RecvLen + len;
      if RecvLen >= fFileSize then
      begin
        fSendString :=
          TRANSFER_TOKEN + FINISHED_FILETRANSFER_TOKEN + TRANSFER_TOKEN;
        fSocketStream.Write(fSendString[1], Length(fSendString));
        p := RecvLen - fFileSize;
        FileWrite(fFileHandle, fBuffer, len - p);
        Result := True;
        break;
      end
      else
        FileWrite(fFileHandle, fBuffer, len);
    end;
    tim := GetTickCount;
    repeat
      sleep(100);
    until (not ClientSocket.Connected) or ((GetTickCount - tim) > 2000);
  finally
    try
      ClientSocket.Close;
      if fFileHandle > 0 then
        FileClose(fFileHandle);
      fFileHandle := -1;
    except
    end;
  end;
end;
function TFileTransferServerThread.ProcessReceiveBackupFile: Boolean;
var
  s: string;
  p: integer;
begin
  result := False;
  try
    s := fData;
    Delete(s, Pos(FILESIZE_TOKEN, s), 1000);
    Delete(s, 1, Pos(SENDING_BACKUPFILE_TOKEN,
      s) + Length(SENDING_BACKUPFILE_TOKEN) - 1);
    fFileName := Trim(s);
    s := fData;
    Delete(s, Pos(TRANSFER_TOKEN, s), 1000);
    Delete(s, 1, Pos(FILESIZE_TOKEN, s) + Length(FILESIZE_TOKEN) - 1);
    try
      fFileSize := strtoint(Trim(s));
    except fFileSize := 0
    end;
    p := Pos('', fFileName);
    while p > 0 do
    begin
      Delete(fFileName, 1, p);
      p := Pos('', fFileName);
    end;
    fFileName := SERVERDATAPATH + fFileName;
    fSendString := PLEASE_SEND_TOKEN;
    fSocketStream.Write(fSendString[1], Length(fSendString));
    result := ReceiveAndWriteTheData;
  finally
    Terminate;
  end;
end;
function TFileTransferServerThread.ProcessReceiveVideoFile: Boolean;
var
  s: string;
  p: integer;
begin
  result := False;
  try
    s := fData;
    Delete(s, Pos(FILESIZE_TOKEN, s), 1000);
    Delete(s, 1, Pos(SENDING_VIDEOFILE_TOKEN,
      s) + Length(SENDING_VIDEOFILE_TOKEN) - 1);
    fFileName := Trim(s);
    s := fData;
    Delete(s, Pos(TRANSFER_TOKEN, s), 1000);
    Delete(s, 1, Pos(FILESIZE_TOKEN, s) + Length(FILESIZE_TOKEN) - 1);
    try
      fFileSize := strtoint(Trim(s));
    except fFileSize := 0
    end;
    p := Pos('', fFileName);
    while p > 0 do
    begin
      Delete(fFileName, 1, p);
      p := Pos('', fFileName);
    end;
    fFileName := SERVERVIDEOPATH + fFileName;
    if Pos(AppDrive, fFileName) <> 1 then
    begin
      Delete(fFileName, 1, Pos(':', fFileName));
      fFileNAme := AppDrive + fFileName;
    end;
    if FileExists(fFileName) then
      fSendString := DUPLICATED_FILE_TOKEN
    else
      fSendString := PLEASE_SEND_TOKEN;
    fSocketStream.Write(fSendString[1], Length(fSendString));
    result := ReceiveAndWriteTheData;
  finally
    Terminate;
  end;
end;
function TFileTransferServerThread.ProcessSendFile: Boolean;
var
  s: string;
  p: integer;
  srec: TSearchRec;
begin
  result := False;
  try
    s := fData;
    Delete(s, Pos(TRANSFER_TOKEN, s), 1000);
    Delete(s, 1, Pos(REQUEST_FILETRANSFER_TOKEN,
      s) + Length(REQUEST_FILETRANSFER_TOKEN) - 1);
    fFileName := Trim(s);
    if Pos(AppDrive, fFileName) <> 1 then
    begin
      Delete(fFileName, 1, Pos(':', fFileName));
      fFileName := AppDrive + fFileName;
    end;
    if not FileExists(fFileName) then
    begin
      s := FILENOTFOUND_TOKEN + TRANSFER_TOKEN;
      fSocketStream.Write(s[1], Length(s));
      exit;
    end
    else
    begin
      fFileSize := 0;
      p := FindFirst(fFileName, faAnyFile, srec);
      if p = 0 then
        fFileSize := srec.Size;
      FindClose(srec);
      if Pos(AppDrive, fFileName) <> 1 then
      begin
        Delete(fFileName, 1, Pos(':', fFileName));
        fFileNAme := AppDrive + fFileName;
      end;
      fFileHandle := FileOpen(fFileName, fmOpenRead or fmShareExclusive);
      if fFileHandle = -1 then
      begin
        s := FILELOCKED_TOKEN + TRANSFER_TOKEN;
        fSocketStream.Write(s[1], Length(s));
        exit;
      end
      else
        result := ProcessSendTheFile;
    end;
  except
  end;
end;
function TFileTransferServerThread.ProcessSendFileInfo: Boolean;
var
  s, folder, fname, fmtstr: string;
  p: integer;
  srec: TSearchRec;
begin
  result := False;
  try
    s := fData;
    Delete(s, Pos(TRANSFER_TOKEN, s), 1000);
    Delete(s, 1, Pos(REQUEST_FILEINFO_TOKEN,
      s) + Length(REQUEST_FILEINFO_TOKEN) - 1);
    fFileName := Trim(s);
    if Pos(AppDrive, fFileNAme) <> 1 then
    begin
      Delete(fFileName, 1, Pos(':', fFileName));
      fFileName := AppDrive + fFileName;
    end;
    s := ReverseString(fFileName);
    p := Pos('', s);
    folder := '';
    fname := fFileName;
    if p > 0 then
    begin
      p := Length(s) - p;
      folder := Copy(fFileName, 1, p + 1);
      fname := Copy(fFileName, p + 2, 1000);
    end;
    p := FindFirst(fFileName, faAnyFile, srec);
    if p = 0 then
    begin
      fmtstr := SENDING_FILEINFO_TOKEN + ' %s ' +#13#10+ 'FILESIZE= %d ' +
        TRANSFER_TOKEN;
      ;
      s := Format(fmtstr, );
    end
    else
      s := FILENOTFOUND_TOKEN + TRANSFER_TOKEN;
    fSocketStream.Write(s[1], Length(s));
    result := True;
    FindClose(srec);
  finally
    Terminate;
  end;
end;
function TFileTransferServerThread.ProcessRenameVideoFile: Boolean;
var
  s: string;
  p: integer;
begin
  result := False;
  try
    s := fData;
    Delete(s, Pos(TRANSFER_TOKEN, s), 1000);
    Delete(s, 1, Pos(REQUEST_RENAMEVIDEOFILE_TOKEN,
      s) + Length(REQUEST_RENAMEVIDEOFILE_TOKEN) - 1);
    fFileName := Trim(s);
    p := Pos('', fFileName);
    while p > 0 do
    begin
      Delete(fFileName, 1, p);
      p := Pos('', fFileName);
    end;
    fFileName := SERVERVIDEOPATH + fFileName;
    fSendString := FILENOTFOUND_TOKEN + TRANSFER_TOKEN;
    s := fFileName;
    p := Pos('.WMV', fFileName);
    if p > 0 then
    begin
      Delete(s, p, 100);
      s := s + '.R.WMV';
      if BSRenameFile(fFileName, s) then
        fSendString := FINISHED_FILETRANSFER_TOKEN + TRANSFER_TOKEN;
    end;
    fSocketStream.Write(fSendString[1], Length(fSendString));
  finally
    Terminate;
  end;
end;
function TFileTransferServerThread.ProcessSendTheFile: Boolean;
var
  actual, len, tot: integer;
  s, fmtstr: string;
  tim: DWORD;
begin
  result := False;
  try
    fmtstr := SENDING_FILE_TOKEN + ' %s ' + FILESIZE_TOKEN + ' %d ' +
      TRANSFER_TOKEN;
    s := Format(fmtstr, [fFileName, fFileSize]);
    fSocketStream.Write(s[1], Length(s));
    repeat
      begin
        len := FileRead(fFileHandle, fBuffer, SOCKETBUFFERSIZE);
        actual := 0;
        while actual < len do
        begin
          tot := fSocketStream.Write(fBuffer[actual], (len - actual));
          actual := actual + tot;
          if tot = 0 then // ada masalah dlm pengiriman mk abort
            exit;
        end;
      end
    until
      (len = 0) or (not ClientSocket.Connected) or Terminated;
    FileClose(fFileHandle);
    fFileHandle := -1;
    s := '                        ';
    fSocketStream.Write(s[1], Length(s));
    tim := GetTickCount;
    repeat
      sleep(100);
    until
      (not ClientSocket.Connected) or ((getTickCount - tim) > 2000);
    result := True;
  finally
    Terminate;
  end;
end;
function TFileTransferServerThread.ProcessDataFileListing: Boolean;
var
  s, folder, fname, fmtstr: string;
  p: integer;
  srec: TSearchRec;
begin
  result := False;
  try
    s := fData;
    Delete(s, Pos(TRANSFER_TOKEN, s), 1000);
    Delete(s, 1, Pos(REQUEST_DATAFILELISTING_TOKEN,
      s) + Length(REQUEST_DATAFILELISTING_TOKEN) - 1);
    fFileName := Trim(s);
    if Pos(AppDrive, fFileName) <> 1 then
    begin
      Delete(fFileName, 1, Pos(':', fFileName));
      fFileName := AppDrive + fFileName;
    end;
    s := ReverseString(fFileName);
    p := Pos('', s);
    folder := '';
    fname := fFileName;
    if p > 0 then
    begin
      p := Length(s) - p;
      folder := Copy(fFileName, 1, p + 1);
      fname := Copy(fFileName, p + 2, 1000);
    end;
    s := SENDING_DATAFILELISTING_TOKEN;
    p := FindFirst(fFileName, faAnyFile, srec);
    if p = 0 then
    begin
      s := s +#13#10+ srec.Name;
    end
    else
      s := FILENOTFOUND_TOKEN;
    s := s + TRANSFER_TOKEN;
    fSocketStream.Write(s[1], Length(s));
    result := True;
    FindClose(srec);
  finally
    Terminate;
  end;
end;
user image
more 17 years ago

cikumiyu

Yha, aku baru inget kalau memang masalahnya kalo ngga salah waktu itu handling type dari socketnya (blocking dan non-blocking). Pada aplikasi console non-blocking ngga jalan. Tapi justru aku mau bikin non-blocking diaplikasi console. Karena ngga mungkin server akan sanggup menghandle ribuan client dengan mode blocking. Tapi apa benar TServerSocket ngga bisa non-blocking di console? Kalo benar kenapa yha. Atau mungkin ada hubungannya dengan sinkronisasi object (TCriticalSection, TThread.Synchronization, dsb) karena aku pernah mendapat info kalau salah satu tekhik sikronisasi object tersebut ngga jalan pada aplikasi console.
user image
more 17 years ago

gust4m4n

menurut gw, untuk servernya jangan pake client thread...soalnya di windows ada ilimit jumlah thread per process/aplikasi kalo gak salah 2048. gak mungkin kan mo bikin server yg clientnnya max 2048 ekor. lagian cost cpu nya juga lumayan kalo pake banyak thread. :) TServerSocket kalo gak salah bisa non-blocking di console, tapi harus masang message loop (Window) sendiri, soalnya TServerSocket buat synchronizationnya pake message loop. :)
user image
more 17 years ago

mat_koder

lo mau ribuan client artikel berikut mungkin berguna: http://www.teknisoft.net/download/artikel/delphi/membangun-hiload-tcpipserver.dpr
user image
more 17 years ago

cikumiyu

@gust4m4n: menurut gw, untuk servernya jangan pake client thread...soalnya di windows ada ilimit jumlah thread per process/aplikasi kalo gak salah 2048. gak mungkin kan mo bikin server yg clientnnya max 2048 ekor. lagian cost cpu nya juga lumayan kalo pake banyak thread. :)
Setuju. Maksudku bukan 1 thread 1 client. Tapi listener-nya yang dibuat 1 thread sendiri (non-blocking).
TServerSocket kalo gak salah bisa non-blocking di console, tapi harus masang message loop (Window) sendiri, soalnya TServerSocket buat synchronizationnya pake message loop. :)
Sorry, message loop yang bagaiman maksudnya?
more ...
  • Pages:
  • 1
  • 2
Share to

AI Forward

🚀 We're thrilled to partner with Alibaba Cloud for "AI Forward - Alibaba Cloud Global Developer Summit 2025" in Jakarta! Join us and explore the future of AI. Register now: https://int.alibabacloud.com/m/1000400772/
#AlibabaCloud #DeveloperSummit #Jakarta #AIFORWARD

Local Business Directory, Search Engine Submission & SEO Tools FreeWebSubmission.com SonicRun.com