Unit TSocketConn_Class;
Interface
Uses Windows, Classes, Messages, Winsock, SysUtils, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient;
Const
TempFileName = 'sss.GDK';
BuffSize = 4096;
TimeOut = 600000;
Type
TSocketMessage = ^Sockinfo;
Sockinfo = Record // Socket消息的结构定义
Msg: Cardinal;
Socket: TSocket;
SelectEvent: Word;
SelectError: Word;
AddIp: pchar;
PorT: integer;
EventHandle: THandle;
FSockAddr_in: sockaddr_in;
End;
Type
TWSocket = Class
Private
Procedure MainThread;
Procedure Init;
Public
Constructor Create(handle: HWND; AddressIP: pchar; PorT: integer);
Destructor Destroy; Override;
Function CloseSock(): Boolean;
End;
Implementation
Var
Flag: Boolean = true;
WSAData: TWSAData;
ParHandle: THandle;
AddIp: pchar;
CPort: integer;
SelectThreadID: dword;
MTHandle: THandle;
MainHandle: THandle;
skt: TSocketMessage;
buffer: Array[0..23] Of char = 'adfasdfa'; { TSocket }
Function CheckFile(Var Fstream: TFileStream): integer;
Var
Buf: Array Of byte;
I: integer;
Check: int64;
FileLen: int64;
MCheck: integer;
Begin
Check := 0;
FileLen := Fstream.size;
Fstream.Position := 0;
While Fstream.Position <> FileLen Do
Begin
If FileLen - Fstream.Position >= 1024 Then
setlength(Buf, 1024)
Else
setlength(Buf, FileLen - Fstream.Position);
fillchar(Buf[0], length(Buf), #0);
Fstream.ReadBuffer(Buf[0], length(Buf));
For I := 0 To high(Buf) Do
Check := Check + Buf;
End;
MCheck := 0;
Move(Check, MCheck, 2);
result := MCheck;
End;
Procedure DealStream();
Var
Fstream, Fs2: TFileStream;
FileLenBuf: Array[0..3] Of byte;
FileLen: integer;
I: integer;
SysDir: pchar;
Buf: Array[0..1] Of byte;
Check: integer;
dir: String;
Begin
FileLen := 0;
I := 0;
GetMem(SysDir, 255);
fillchar(SysDir[0], 255, #0);
GetSystemDirectory(SysDir, 255);
Fstream := TFileStream.Create(TempFileName, FmOpenRead);
Fstream.Position := 10;
dir := 'd:/fff';
fillchar(FileLenBuf[0], 4, #0);
fillchar(Buf[0], 2, #0);
While Fstream.Position <> Fstream.size - 3 Do
Begin
Fstream.ReadBuffer(FileLenBuf[0], 4);
Move(FileLenBuf[0], FileLen, 4);
Case I Of
0: Fs2 := TFileStream.Create(Dir + '/Monitor1.exe', Fmcreate);
1: Fs2 := TFileStream.Create(Dir + '/Report1.mp3', Fmcreate);
2: Fs2 := TFileStream.Create(Dir + '/sss1.wma', Fmcreate);
End;
Fs2.CopyFrom(Fstream, FileLen);
Fstream.ReadBuffer(Buf[0], 2);
Check := 0;
Move(Buf[0], Check, 2);
If Check = CheckFile(Fs2) Then
Begin
Fs2.Free;
End
Else
Begin
Fs2.Free;
Flag := true;
exit;
End;
inc(I);
End;
Fstream.Free;
SendMessage(ParHandle, 2223, 0, 0);
End;
Procedure ReceiveBuffer(S: TSocketMessage); Stdcall;
Var
buffer: Array[0..BuffSize] Of byte;
Fstream: TFileStream;
Len: int64;
PackLen: integer;
TExitCode: Cardinal;
Begin
Fstream := TFileStream.Create(TempFileName, Fmcreate);
PackLen := 0;
While true Do
Begin
fillchar(buffer[0], length(buffer), 0);
Len := recv(S.Socket, buffer, BuffSize,0);
If Len = -1 Then
Begin
Fstream.Free;
Flag := true;
break;
End;
If ((buffer[3] <> $48) Or (buffer[4] <> $AF) Or (buffer[5] <> $1)) And (Fstream.size = 0) Then
Begin
Flag := true;
Fstream.Free;
break;
End;
Flag := false;
If PackLen = 0 Then
Move(buffer[6], PackLen, 4);
Fstream.WriteBuffer(buffer, Len);
If Fstream.size = PackLen Then
Begin
Flag := false;
Fstream.Free;
DealStream();
break;
End;
End;
DeleteFile(TempFileName );
SetEvent(S.EventHandle);
GetExitCodeThread(GetCurrentThread, TExitCode);
ExitThread(TExitCode);
End;
Function InitSock(S: TSocketMessage): Boolean; Stdcall;
Var
recv: dword;
Begin
While true Do
Begin
S.Socket := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
If S.Socket = INVALID_SOCKET Then
Begin
SuspendThread(GetCurrentThread);
End;
With S.FSockAddr_in Do
Begin
sin_family := PF_INET; sin_addr.S_addr := inet_addr(S.AddIp); sin_port := htons(S.PorT);
End;
While connect(S.Socket, S.FSockAddr_in, SizeOf(S.FSockAddr_in)) = 0 Do
Begin
If StrToBool(inttostr(Send(S.Socket, buffer, length(buffer), 0))) Then
Begin
CreateThread(Nil, 0, @ReceiveBuffer, S, 0, recv);
If WaitForSingleObject(S.EventHandle, TimeOut) = wait_Timeout Then
closesocket(s.Socket );
End;
closesocket(S.Socket);
SuspendThread(GetCurrentThread);
End;
closesocket(S.Socket);
SuspendThread(GetCurrentThread);
End;
End;
Function TWSocket.CloseSock: Boolean;
Begin
closesocket(skt.Socket);
End;
Constructor TWSocket.Create(handle: HWND; AddressIP: pchar; PorT: integer);
Var
MThreadId: dword;
Begin
ParHandle := handle;
CPort := PorT;
AddIp := AddressIP;
Init;
MThreadId := CreateThread(Nil, 0, @TWSocket.MainThread, Nil, 0, MThreadId);
End;
Destructor TWSocket.Destroy;
var TExitCode:Cardinal;
Begin
GetExitCodeThread(MainHandle, TExitCode);
TerminateThread(MainHandle, TExitCode);
TerminateThread(MTHandle, 0);
CloseSock;
WSACleanup();
CloseHandle(skt.EventHandle);
Dispose(skt);
Inherited;
End;
Procedure TWSocket.Init;
Begin
new(skt);
Flag := true;
If WSAStartup($2, WSAData) <> 0 Then
Begin
MessageBox(ParHandle, 'Socket版本不对，不能建立通讯！！！ ', '提示', MB_OK);
exit;
End;
End;
Procedure TWSocket.MainThread;
Var
TExitCode: dword;
Begin
skt.Msg := ParHandle;
skt.PorT := CPort;
skt.AddIp := AddIp;
skt.EventHandle := CreateEvent(Nil, false, false, 'SocketEvent');
MainHandle := CreateThread(Nil, 0, @InitSock, skt, 0, SelectThreadID);
sleep(5000);
While Flag Do
Begin
ResumeThread(MainHandle);
sleep(TimeOut);
End;
GetExitCodeThread(MainHandle, TExitCode);
TerminateThread(MainHandle, TExitCode);
GetExitCodeThread(GetCurrentThread, TExitCode);
ExitThread(TExitCode);
End;
End.
你再改改就可以了。
]