Delphi控件源码

开发平台：
Delphi

PSMFireW.dpr：源码内容
							{
Injected DLL for PSM Firewall.
(C) 2003 PSMKorea, http://www.psmkorea.co.kr
Written by DoDucTruong, Truong2D@Yahoo.com
}
Library PSMFireW;
uses
  SysUtils,
  Windows,
  Classes,
  Registry,
  Messages,
  madCodeHook,
  madRemote,
  StrUtils,
  WinSock,
  InitAndFina in 'InitAndFina.pas';
{$R *.res}
Const
  PSM_REG_KEY=HKEY_LOCAL_MACHINE;
  //PSM_REG_KEY=HKEY_CURRENT_USER;
  PSM_REG_FIREWALL_PATH='SOFTWAREPSMFirewall';
  REQUEST_TIMEOUT = 100;
  MAX_HIS = 20;
  MAX_DOMAIN_HIS=20;
Var
  acceptNext: function(s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket; stdcall;
  connectNext: function(s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall;
  recvNext: function(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
  recvfromNext: function(s: TSocket; var Buf; len, flags: Integer; var from: TSockAddr; var fromlen: Integer): Integer; stdcall;
  sendNext: function(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
  sendtoNext: function(s: TSocket; var Buf; len, flags: Integer; var addrto: TSockAddr; tolen: Integer): Integer; stdcall;
  AcceptExNext: function(sListenSocket, sAcceptSocket: TSocket;
  lpOutputBuffer: Pointer; dwReceiveDataLength, dwLocalAddressLength,
  dwRemoteAddressLength: DWORD; var lpdwBytesReceived: DWORD;
  lpOverlapped: POverlapped): BOOL; stdcall;
  (*DeviceIoControlNext: function(hDevice: THandle; dwIoControlCode: DWORD; lpInBuffer: Pointer;
  nInBufferSize: DWORD; lpOutBuffer: Pointer; nOutBufferSize: DWORD;
  var lpBytesReturned: DWORD; lpOverlapped: POverlapped): BOOL; stdcall;
  *)
  gethostbynameNext:function (name: PChar): PHostEnt; stdcall;
  //f:textfile;
  Level: Byte=1;
  PermitPath: Byte=2;
  //Idea for Speed
  Allow: Array[0..MAX_HIS] of string[30];
  Deny: Array[0..MAX_HIS] of string[30];
  iAllow: Byte=0;
  iDeny: Byte=0;
  //Idea for AntiRepeated
  oldIPPort: String[30]='';
  oldTime: Cardinal=0;
  //Total Bytes Received/Sent
  bRec: DWORD=0;
  bSen: DWORD=0;
  bTotal: DWORD=0;
  //DoMainName<->IPs
  DomainName:array[0..MAX_DOMAIN_HIS] of shortstring;
  DomainIP:array[0..MAX_DOMAIN_HIS] of string[30];
  iDomain: Byte=0;
  //AntiQ
  dT: Cardinal=0;
  dM: WORD=0;
  stopT: Cardinal=0;
//Registry**********************************************************************
(*
function GetSettings(myKey: HKEY;RegPath:string;Key:string):string;
var
  reg: Tregistry;
begin
  result:='';
  Reg:=TRegistry.Create;
  try
    Reg.RootKey:=myKey;
    try
      if Reg.OpenKey(RegPath,False) then
        result:=Reg.ReadString(Key);
    finally
    end;
  finally
    Reg.Free;
  end;{try}
end;
function SaveSettings(myKey: HKEY;RegPath:string;Key:string;Value:string):Boolean;
var
  reg: Tregistry;
begin
  result:=false;
  Reg:=TRegistry.Create;
  try
    Reg.RootKey:=myKey;
    try
      if Reg.OpenKey(RegPath,True) then
      begin
        Reg.WriteString(Key,Value);
        result:=true;
        Reg.CloseKey;
      end;
    finally
    end;
  finally
    Reg.Free;
  end;{try}
end;
*)
//******************************************************************************
Procedure GetIPAndPort(s: TSocket;var ip: string; var port: integer; var localport: integer);
Var
  name: TSockAddr;
  namelen: Integer;
Begin
  try
  namelen:=sizeof(name);
  getpeername(s,name,namelen);
  ip:=inet_ntoa(name.sin_addr);
  port:=ntohs(name.sin_port);
  getsockname(s,name,namelen);
  localport:=ntohs(name.sin_port);
  except
    SendIpcMessage('PSMFirewall', Pchar(' Error at GetIPAndPort()'#0),length(' Error at GetIPAndPort()'#0),nil,0);
    SysUtils.Beep;
  end;
End;
Function CheckPermission(ip: string; port: integer): Byte;
{
0:Permit
1:Not Permit
2:Default;
}
Var
  //I, j, pos1, pos2: Integer;
  I, j: Integer;
  FromIP, ToIP, st: String;
  FromPort, ToPort: Integer;
  MyIP: String;
Begin
  //12345678911234567892123456789312345678941234567890
  //211.233.011.101|211.233.011.101|00080|00080|0|0
  Result:=2;
  Try
  if PermitPath=0 then
    Result:=0
  else
  Begin
    MyIP:='000.000.000.000';
    j:=Length(ip);
    For i:=15 downto 1 do
    Begin
      if j<1 then break;
      if (ip[j]<>'.') then
      begin
        MyIP[i]:=ip[j];
        j:=j-1;
      end
      else if MyIP[i]='.' then j:=j-1;
    End;
    //MessageBox(0,Pchar(MyIP),'MyIP',MB_OK);
    for I:=0 to Rules.Count-1 do
    begin
      st:=Rules.Strings[I];
      FromIP:=copy(st,1,15);
      ToIP:=copy(st,17,15);
      FromPort:=StrToInt(copy(st,33,5));
      ToPort:=StrToint(copy(st,39,5));
      //MessageBox(0,Pchar(FromIP + #9 + ToIP + #9 + IntToStr(FromPort) + #9 + IntToStr(ToPort)),'Rule',MB_OK);
      if (myip>=FromIP)and(myip<=ToIP)and(port>=FromPort)and(port<=ToPort)then
      Begin
        if st[47]='0' then Result:=0
        else Result:=1;
        Break;
      End;
    {
    pos2:=0;
    for j:= 1 to length(st) do if st[j]='|' then
    begin
      pos1:=pos2+1;
      pos2:=j;
    end;
    pos2:=pos('|',st);if pos2< 1 then continue;
    FromIP:=copy(st,pos1,pos2-pos1);
    }
    End;
    if (Result=2)and(PermitPath=1) then Result:=1;
  End;
  Except
    //SendIpcMessage('PSMFirewall', Pchar(' Error at CheckPermission(): ' + IntToStr(GetLastError()) + #0),Length(' Error at CheckPermission(): ' + IntToStr(GetLastError()) + #0),nil,0,IGNORE, TRUE);
    SendIpcMessage('PSMFirewall', Pchar(' Error at CheckPermission(): ' + IntToStr(GetLastError()) + #0),Length(' Error at CheckPermission(): ' + IntToStr(GetLastError()) + #0),nil,0);
    SysUtils.Beep;
  End;
End;
Procedure LoadRules();
Var
  I: Integer;
  reg: Tregistry;
  regPath:string;
  Rules1 :TStringList;
Begin
  Try
  //Next Version, rules will be loaded to share memory by Application. This procedure will open this map file for use only.
  iAllow:=0;
  iDeny:=0;
  Level:=1;
  PermitPath:=2;
  oldIPPort:='';
  FillChar(Allow,SizeOf(Allow),' ');
  FillChar(Deny,SizeOf(Allow),' ');
  {
  dT:=0;
  dM:=0;
  oldTime:=0;
  stopT:=GetTickCount;
  }
  {
  for i:=0 to MAX_HIS do begin
    Allow[i]:='!';
    Deny[i]:='!';
  end;
  }
  //SendIpcMessage('PSMFirewall', Pchar(' Loading Rules: ' + DLLPath + #0),Length(' Loading Rules: ' + DLLPath + #0),nil,0,IGNORE, TRUE);
  SendIpcMessage('PSMFirewall', Pchar(' Loading Rules: ' + DLLPath + #0),Length(' Loading Rules: ' + DLLPath + #0),nil,0);
  regPath:=PSM_REG_FIREWALL_PATH + 'Rules';
  Reg:=TRegistry.Create;
  try
    Reg.RootKey:=PSM_REG_KEY;
    if Reg.OpenKey(PSM_REG_FIREWALL_PATH,False) then
    begin
      try
        Level:=Reg.ReadInteger('Level');
      except
        Level:=1;//Default
      end;
    end
    else
      //SendIpcMessage('PSMFirewall', Pchar(' Error OpenKey(1): ' + PSM_REG_FIREWALL_PATH + #0),length(' Error OpenKey(1): ' + PSM_REG_FIREWALL_PATH + #0),nil,0,IGNORE, TRUE);;//Error trap
      SendIpcMessage('PSMFirewall', Pchar(' Error OpenKey(1): ' + PSM_REG_FIREWALL_PATH + #0),length(' Error OpenKey(1): ' + PSM_REG_FIREWALL_PATH + #0),nil,0);;//Error trap
    Reg.CloseKey;
    if Reg.OpenKey(regPath,False) then
    begin
      if Rules<>nil then Rules.Free;
      Rules:=TStringList.Create;
      Reg.GetValueNames(Rules);
      for I:=0 to Rules.Count-1 do
        //SendIpcMessage('PSMFirewall', Pchar(' ' + IntToStr(Level) + '     ' + Rules.Strings[I]  + '     ' + DllPath + #0),strlen(Pchar(' ' + IntToStr(Level) + '     ' + Rules.Strings[I] + '     ' + DllPath + #0)),nil,0);
    end
    else
      //SendIpcMessage('PSMFirewall', Pchar(' Error OpenKey(2): ' + regPath + #0),length(' Error OpenKey(2): ' + regPath + #0),nil,0,IGNORE, TRUE);;//Error trap
      SendIpcMessage('PSMFirewall', Pchar(' Error OpenKey(2): ' + regPath + #0),length(' Error OpenKey(2): ' + regPath + #0),nil,0);;//Error trap
    Reg.CloseKey;
    PermitPath:=2;
    regPath:=PSM_REG_FIREWALL_PATH + 'Rules1';
    if Reg.OpenKey(regPath,False) then
    begin
      Rules1:=TStringList.Create;
      Reg.GetValueNames(Rules1);
      for I:=0 to Rules1.Count-1 do
      begin
        if (pos(DllPath,Rules1.Strings[I])>0)then
          if (Rules1.Strings[I][Length(Rules1.Strings[I])]='0') then
            PermitPath:=0
          else
            PermitPath:=1;
        //SendIpcMessage('PSMFirewall', Pchar(' ' + IntToStr(Level) + '     ' + Rules1.Strings[I]  + '     ' + DllPath),strlen(Pchar(' ' + IntToStr(Level) + '     ' + Rules1.Strings[I] + '     ' + DllPath)),nil,0);
      end;
      Rules1.Free;
    end
    else
      //SendIpcMessage('PSMFirewall', Pchar(' Error OpenKey(3): ' + regPath),length(' Error OpenKey(3): ' + regPath),nil,0,IGNORE, TRUE);;//Error trap
      SendIpcMessage('PSMFirewall', Pchar(' Error OpenKey(3): ' + regPath + #0),length(' Error OpenKey(3): ' + regPath + #0),nil,0);;//Error trap
    Reg.CloseKey;
  finally
    Reg.Free;
  end;
  Except
    //SendIpcMessage('PSMFirewall', Pchar(' Error at LoadRules(): ' + IntToStr(GetLastError())),Length(' Error at LoadRules(): ' + IntToStr(GetLastError())),nil,0,IGNORE, TRUE);
    SendIpcMessage('PSMFirewall', Pchar(' Error at LoadRules(): ' + IntToStr(GetLastError()) + #0),Length(' Error at LoadRules(): ' + IntToStr(GetLastError()) + #0),nil,0);
    SysUtils.Beep;
  End;
End;
Function WriteLog(const s: Tsocket; const Direction: string; const ip: string; const port: integer; const localport: Integer): BOOL;
var
  t:SYSTEMTIME;
  //fn: array[0..MAX_PATH-1] of char;
  msg:string;
  Permit,i: Byte;
  strPermit: String;
  inRecent: BOOL;
  IPPort:String;
  CurrentTick: Cardinal;
  HMapMutex: THandle;
  tmpTotal: DWORD;
  strDomain: ShortString;
Begin
  Result:=True;
  try
  if (PMapData=nil) and not MapOpened then Openmap;
  if (PMapData=nil) or (PMapData^.boNewRule[MyProcessID]=2) then exit;//FW is stopped
  if (PMapData<>nil) and (PMapData^.boNewRule[MyProcessID]=1) then begin
    PMapData^.boNewRule[MyProcessID]:=0;
    LoadRules;
  end;
  inRecent:=False;
  IPPort:=ip+':'+IntToStr(Port);
  For i:=0 to MAX_HIS do
  Begin
    if IPPort = Allow[i] then
    Begin
      Result:=True;
      inRecent:=True;
      Break;
    End
    else if IPPort=Deny[i] then
    Begin
      Result:=False;
      inRecent:=True;
      Break;
    End;
  End;
  if not inRecent then
  Begin
    //SendIpcMessage('PSMFirewall', Pchar(' New IP/Port'),Length(' New IP/Port'),nil,0,IGNORE, TRUE);
    SendIpcMessage('PSMFirewall', Pchar(' New IP/Port'#0),Length(' New IP/Port'#0),nil,0);
    Permit:=CheckPermission(ip,port);
    Case Level of
      0:Begin
          if Permit=0 then Result:=False;
        End;
{
      1:Begin
          if Permit=1 then Result:=True
          else if Permit=0 then result:=False
          else if (port<>34223) then Result:=True
          else Result:=False;
        End;
}
      1:Begin
          if Permit=1 then Result:=True
          else if Permit=0 then result:=False
          else if (ip='127.0.0.1')
            or (ip='0.0.0.0')//service.exe
            or (ip='0.0.7.0')//service.exe
            or (port<140)//Major port such as FTP, Telnet, HTTP, etc.
            or (port=443)//ssl(for yessign certificate)
            or (port=444)//snpp, Simple Network Paging Protocol
            or (port=520)//RIP (Routing Information Protocol)
            or (port=545)//QuickTime
            or (port=554)//Real Time Streaming Protocol
            or (port=563)//NNTP over SSL
            or (port=631)//IPP (Internet Printing Protocol)
            or (port=1352)//Lotus Notes
            or (port=1433)//Microsoft SQL Server
            or (port=1434)//Microsoft SQL Monitor
            or (port=1521)//Oracle SQL
            or (port=1755)//Windows Media .asf
            or (port=1863)//MSM Messenger
            or (port=2048)//Printer
            or (port=3306)//mySQL
            or (port=3389)//RDP Protocol (Terminal Server)
            or (port=4000)//icq, command-n-conquer
            or (port=4098)//SignKorea Cer.
            or (port=4333)//mSQL
            or (port=4608)//icq
            or (port=5050)//Yahoo Messenger
            or (port=5120)//Woori Bank Cer. Manager - Client SM
            or (port=5190)//icq
            or (port=5631)//PCAnywhere data
            or (port=5632)//PCAnywhere
            or (port=7007)//MSBD, Windows Media encoder
            or (port=7070)//RealServer/QuickTime
            or (port=8080)//HTTP
            or (port=8181)//HTTP
            or (port=8383)//IMail WWW
            or (port=35072)////Woori Bank Cer. Manager - Client SM (When disconnecting)
            or (port=63860)//Yahoo Pops
            or (pos('inetinfo.exe',DllPath)>0)//Web Server
            or (pos('services.exe',DllPath)>0)//services
            or (pos('rpcss.exe',DllPath)>0)//RPC
            or (pos('spoolsv.exe',DllPath)>0)//NetPrinter
            or (pos('isaferupdate.exe',DllPath)>0)//iSaferUpdate.exe
          then Result:=True
          else Result:=False;
        End;
      2:Begin
          if Permit<>1 then Result:=False;
        End;
    end;
    if Result then
    Begin
      Allow[iAllow]:=IPPort;//ip + ':' + IntToStr(Port);
      iAllow:=(iAllow + 1) mod (MAX_HIS+1);
    end
    else
    Begin
      Deny[iDeny]:=IPPort;//ip + ':' + IntToStr(Port);
      iDeny:=(iDeny + 1) mod (MAX_HIS+1);
    End;
  End;
  if Result then strPermit:='ALLOW'
  else Begin strPermit:= 'DENY'; End;//SysUtils.Beep;
  CurrentTick:=GetTickCount();
  if ((IPPort <> oldIPPort) or ((CurrentTick-oldTime)>1000)) and ((CurrentTick-stopT)>2000) and (ip<>'0.0.0.0')  and (ip<>'127.0.0.1') and (Port<>0) then// 1000 ms// or (Direction='IN') or (Direction='OUT')
  Begin
    dT:=dT+(CurrentTick-oldTime);
    inc(dM);
    if (dT>10) and ((dM/dT)>(5/1000)) then stopT:=CurrentTick;
    if (dT>1000)or(stopT=CurrentTick) then begin dT:=0; dM:=0; end;
    oldTime:=CurrentTick;
    oldIPPort:=IPPort;
    tmpTotal:=0;
    HMapMutex := CreateMutex(nil, false, pchar('PSMFirewallDLLShareMemMutex'));
    if HMapMutex <> 0 then begin
      if WaitForSingleObject(HMapMutex,REQUEST_TIMEOUT) = WAIT_OBJECT_0 then begin
        if (PMapData<>nil) then begin
          PMapData^.dwTotalBytes:=PMapData^.dwTotalBytes + (bSen + bRec - bTotal);
          tmpTotal:=PMapData^.dwTotalBytes;
          bTotal:=bSen + bRec;
        end;
      end;
      ReleaseMutex(HMapMutex);
      CloseHandle(HMapMutex);
    end;
    GetLocalTime(t);
    strDomain:=ip;
    for i:=0 to MAX_DOMAIN_HIS do if ip=DomainIP[i] then begin
      strDomain:=DomainName[i];
      break;
    end;
    msg:=AnsiReplaceStr(Format('%2d:%2d:%2d:%3d', [t.wHour, t.wMinute, t.wSecond, t.wMilliseconds]),' ','0') + #9 + Direction + #9 + strPermit + #9 + ip + #9 + IntToStr(port) + #9 + DllPath + #9 + IntToStr(bRec) + #9 + IntToStr(bSen) + #9 + IntToStr(tmpTotal) + #9 + IntToStr(s) + #9 + strDomain + #9 + IntToStr(LocalPort);
    //SendIpcMessage('PSMFirewall', Pchar(msg),strlen(Pchar(msg)),nil,0,IGNORE, TRUE);
    SendIpcMessage('PSMFirewall', Pchar(msg + #0),Length(msg + #0),nil,0);
  End;
  {
  GetSystemDirectory(fn,MAX_PATH);
  strcat(fn,'LogFilesPSMFireW');
  if not DirectoryExists(fn) then MkDir(fn);
  StrCat(fn,Pchar('' + AnsiReplaceStr(Format('%4d%2d%2d%s', [t.wYear, t.wMonth, t.wDay, '.log']),' ','0')));
  AssignFile(f,fn);
  if FileExists(fn) then
    Append(f)
  else
    Rewrite(f);
  writeln(f,AnsiReplaceStr(Format('%2d:%2d:%2d', [t.wHour, t.wMinute, t.wSecond]),' ','0') + #9 + name + #9 + Permission + #9 + ip + #9 + ':' + IntToStr(port) + #9 + DllPath);
  Flush(f);
  CloseFile(f);
  }
  Except
    //SendIpcMessage('PSMFirewall', Pchar(' Error at WriteLog(): ' + IntToStr(GetLastError())),Length(' Error at WriteLog(): ' + IntToStr(GetLastError())),nil,0,IGNORE, TRUE);
    SendIpcMessage('PSMFirewall', Pchar(' Error at WriteLog(): ' + IntToStr(GetLastError()) + #0),Length(' Error at WriteLog(): ' + IntToStr(GetLastError()) + #0),nil,0);
    SysUtils.Beep;
  End;
End;
Function acceptCallback(s: TSocket; addr: PSockAddr; addrlen: PInteger): TSocket; stdcall;
Var
  myresult: TSocket;
  ip: string;
  port: integer;
  localport: integer;
Begin
  try
  if addr<>nil then begin
    ip:=inet_ntoa(addr^.sin_addr);
    port:=ntohs(addr^.sin_port);
  end
  else
    GetIPAndPort(s,ip,port,localport);
  if WriteLog(s, 'IN',ip,port, localport) then
  Begin
    if @acceptNext<>nil then
      myresult:=acceptNext(s, addr, addrlen)
    else
      myresult:=accept(s, addr, addrlen);    
    result:=myresult;
  end
  else
  begin
    WSASetLastError(WSAENETDOWN);
    result:= INVALID_SOCKET;
  end;
  if @acceptNext<>nil then RenewHook(@acceptNext);
  except
    SendIpcMessage('PSMFirewall', Pchar(' Error at accept()'#0),length(' Error at accept()'#0) ,nil,0);
    SysUtils.Beep;
    WSASetLastError(WSAENETDOWN);
    result:= INVALID_SOCKET;
  end;
End;
Function connectCallback(s: TSocket; var name: TSockAddr; namelen: Integer): Integer; stdcall;
Var
  myresult: Integer;
  ip: string;
  port: integer;
  localport: Integer;
Begin
  try
  GetIPAndPort(s,ip,port,localport);
  ip:=inet_ntoa(name.sin_addr);
  port:=ntohs(name.sin_port);
  if WriteLog(s,'OUT',ip,port,localport) then
  Begin
    if @connectNext<>nil then
      myresult:=connectNext(s, name, namelen)
    else
      myresult:=connect(s, name, namelen);    
    result:=myresult;
  end
  else
  begin
    WSASetLastError(WSAENETDOWN);
    result:= SOCKET_ERROR;
  end;
  if @connectNext<>nil then RenewHook(@connectNext);
  except
    SendIpcMessage('PSMFirewall', Pchar(' Error at connect()'#0),length(' Error at connect()'#0) ,nil,0);
    SysUtils.Beep;
    WSASetLastError(WSAENETDOWN);
    result:= SOCKET_ERROR;
  end;
End;
Function recvCallback(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
Var
  myresult: Integer;
  ip: string;
  port: integer;
  localport: Integer;
  //HMapMutex: THandle;
Begin
  try
  GetIPAndPort(s,ip,port,localport);
  bRec := bRec + DWORD(len);
  {
  if LockMap then if (PMapData <> nil) then
  Begin
      PMapData^:=PMapData^ + DWORD(len);
      UnlockMap;
  End;
  }
  {
  HMapMutex := CreateMutex(nil, false, pchar('PSMFirewallShareMemMutex'));
  if HMapMutex <> 0 then begin
    if WaitForSingleObject(HMapMutex,REQUEST_TIMEOUT) <> WAIT_FAILED then begin
      PMapData^:=PMapData^ + DWORD(len);
    end;
    ReleaseMutex(HMapMutex);
    CloseHandle(HMapMutex);
  end;
  }
  if WriteLog(s, 'IN',ip,port,localport)then//REC
  begin
    if @recvNext<>nil then myresult:=recvNext(s,Buf,len, flags)
    else myresult:=recv(s,Buf,len, flags);
    result:=myresult;
  end
  else
  begin
    //s:=INVALID_SOCKET; (must change Var s)
    closesocket(s);
    WSASetLastError(WSAENETDOWN);
    result:= SOCKET_ERROR;
  end;
  if @recvNext <> nil then RenewHook(@recvNext);  
  except
    SendIpcMessage('PSMFirewall', Pchar(' Error at recv()'#0),length(' Error at recv()'#0) ,nil,0);
    SysUtils.Beep;
    WSASetLastError(WSAENETDOWN);
    result:= SOCKET_ERROR;
  end;
End;
Function recvfromCallback(s: TSocket; var Buf; len, flags: Integer; var from: TSockAddr; var fromlen: Integer): Integer; stdcall;
Var
  myresult: Integer;
  ip: string;
  port: integer;
  localport: Integer;
  //HMapMutex: THandle;
Begin
  try
  GetIPAndPort(s,ip,port,localport);
  ip:=inet_ntoa(from.sin_addr);
  port:=ntohs(from.sin_port);
  
  bRec := bRec + DWORD(len);
  {
  if LockMap then if (PMapData <> nil) then
  Begin
      PMapData^:=PMapData^ + DWORD(len);
      UnlockMap;
  End;
  }
  {
  HMapMutex := CreateMutex(nil, false, pchar('PSMFirewallShareMemMutex'));
  if HMapMutex <> 0 then begin
    if WaitForSingleObject(HMapMutex,REQUEST_TIMEOUT) <> WAIT_FAILED then begin
      PMapData^:=PMapData^ + DWORD(len);
    end;
    ReleaseMutex(HMapMutex);
    CloseHandle(HMapMutex);
  end;
  }
  If WriteLog(s, 'IN',ip,port,localport) then//RECF
  Begin
    if @recvfromNext<>nil then
      myresult:=recvfromNext(s, Buf, len, flags, from, fromlen)
    else
      myresult:=recvfrom(s, Buf, len, flags, from, fromlen);
    result:=myresult;
  end
  else
  begin
    //s:=INVALID_SOCKET; (must change Var s)
    closesocket(s);
    WSASetLastError(WSAENETDOWN);
    result:= SOCKET_ERROR;
  end;
  if @recvfromNext<>nil then RenewHook(@recvfromNext);  
  except
    SendIpcMessage('PSMFirewall', Pchar(' Error at recvfrom()'#0),length(' Error at recvfrom()'#0) ,nil,0);
    SysUtils.Beep;
    WSASetLastError(WSAENETDOWN);
    result:= SOCKET_ERROR;
  end;
End;
Function sendCallback(s: TSocket; var Buf; len, flags: Integer): Integer; stdcall;
Var
  myresult: Integer;
  ip: string;
  port: integer;
  localport: Integer;
  //HMapMutex: THandle;
Begin
  try
  GetIPAndPort(s,ip,port,localport);
  bSen := bSen + DWORD(len);
  {
  if LockMap then if (PMapData <> nil) then
  Begin
      PMapData^:=PMapData^ + DWORD(len);
      UnlockMap;
  End;
  }
  {
  HMapMutex := CreateMutex(nil, false, pchar('PSMFirewallShareMemMutex'));
  if HMapMutex <> 0 then begin
    if WaitForSingleObject(HMapMutex,REQUEST_TIMEOUT) <> WAIT_FAILED then begin
      PMapData^:=PMapData^ + DWORD(len);
    end;
    ReleaseMutex(HMapMutex);
    CloseHandle(HMapMutex);
  end;
  }
  if WriteLog(s, 'OUT',ip,port,localport)then//SEN
  Begin
    if @sendNext<>nil then myresult:=sendNext(s, Buf, len, flags)
    else myresult:=send(s, Buf, len, flags);
    result:=myresult;
  end
  else
  begin
    //s:=INVALID_SOCKET; (must change Var s)
    closesocket(s);
    WSASetLastError(WSAENETDOWN);
    result:= SOCKET_ERROR;
  end;
  if @sendNext<>nil then RenewHook(@sendNext);  
  except
    SendIpcMessage('PSMFirewall', Pchar(' Error at send()'#0),length(' Error at send()'#0) ,nil,0);
    SysUtils.Beep;
    WSASetLastError(WSAENETDOWN);
    result:= SOCKET_ERROR;
  end;
End;
Function sendtoCallback(s: TSocket; var Buf; len, flags: Integer; var addrto: TSockAddr; tolen: Integer): Integer; stdcall;
Var
  myresult: Integer;
  ip: string;
  port: integer;
  localport: Integer;
  //HMapMutex: THandle;
Begin
  try
  GetIPAndPort(s,ip,port,localport);
  ip:=inet_ntoa(addrto.sin_addr);
  port:=ntohs(addrto.sin_port);
  bSen := bSen + DWORD(len);
  {
  if LockMap then if (PMapData <> nil) then
  Begin
      PMapData^:=PMapData^ + DWORD(len);
      UnlockMap;
  End;
  }
  {
  HMapMutex := CreateMutex(nil, false, pchar('PSMFirewallShareMemMutex'));
  if HMapMutex <> 0 then begin
    if WaitForSingleObject(HMapMutex,REQUEST_TIMEOUT) <> WAIT_FAILED then begin
      PMapData^:=PMapData^ + DWORD(len);
    end;
    ReleaseMutex(HMapMutex);
    CloseHandle(HMapMutex);
  end;
  }
  if WriteLog(s, 'OUT',ip,port,localport) then//SENT
  begin
    if @sendtoNext<>nil then
      myresult:=sendtoNext(s, Buf, len, flags,addrto, tolen)
    else
      myresult:=sendto(s, Buf, len, flags,addrto, tolen);
    result:=myresult;
  End
  else
  begin
    //s:=INVALID_SOCKET; (must change Var s)
    closesocket(s);
    WSASetLastError(WSAENETDOWN);
    result:= SOCKET_ERROR;
  end;
  if @sendtoNext<>nil then RenewHook(@sendtoNext);
  except
    SendIpcMessage('PSMFirewall', Pchar(' Error at sendto()'#0),length(' Error at sendto()'#0) ,nil,0);
    SysUtils.Beep;
    WSASetLastError(WSAENETDOWN);
    result:= SOCKET_ERROR;
  end;
End;
Function AcceptExCallback(sListenSocket, sAcceptSocket: TSocket;
  lpOutputBuffer: Pointer; dwReceiveDataLength, dwLocalAddressLength,
  dwRemoteAddressLength: DWORD; var lpdwBytesReceived: DWORD;
  lpOverlapped: POverlapped): BOOL; stdcall;
Begin
  Result:=AcceptExNext(sListenSocket, sAcceptSocket, lpOutputBuffer, dwReceiveDataLength, dwLocalAddressLength, dwRemoteAddressLength, lpdwBytesReceived, lpOverlapped);
  //SendIpcMessage('PSMFirewall', Pchar(' AcceptEx'),Length(' AcceptEx'),nil,0,IGNORE, TRUE);
  SendIpcMessage('PSMFirewall', Pchar(' AcceptEx'#0),Length(' AcceptEx'#0),nil,0);
End;
{
function DeviceIoControlCallback(hDevice: THandle; dwIoControlCode: DWORD; lpInBuffer: Pointer;
  nInBufferSize: DWORD; lpOutBuffer: Pointer; nOutBufferSize: DWORD;
  var lpBytesReturned: DWORD; lpOverlapped: POverlapped): BOOL; stdcall;
Begin
  Result:=DeviceIoControlNext(hDevice, dwIoControlCode, lpInBuffer, nInBufferSize, lpOutBuffer, nOutBufferSize, lpBytesReturned, lpOverlapped);
  SendIpcMessage('PSMFirewall', Pchar('hDevice#9dwIoControlCode'),Length('hDevice#9dwIoControlCode'),nil,0);
  SendIpcMessage('PSMFirewall', Pchar(IntToStr(hDevice) + #9 + IntToStr(dwIoControlCode) + #9 + DllPath),Length(IntToStr(hDevice) + #9 + IntToStr(dwIoControlCode) + #9 + DllPath),nil,0);
End;
}
function gethostbynameCallback(name: PChar): PHostEnt; stdcall;
type
  TAPInAddr = Array[0..4] of PInAddr;
  PAPInAddr = ^TAPInAddr;
var
  tmp:shortstring;
  myHostEnt:PHostEnt;
  pptr: PAPInAddr;
  i: Integer;
begin
  try
  tmp:=String(name);
  if @gethostbynameNext<>nil then
    myHostEnt:=gethostbynameNext(name)
  else
    myHostEnt:=gethostbyname(name);
  if myHostEnt<>nil then begin
    pptr := PAPInAddr(myHostEnt^.h_addr_list );
    i:=0;
    while pptr^[i] <> NIL do begin
      DomainName[iDomain]:=tmp;
      DomainIP[iDomain]:=inet_ntoa( pptr^[i]^ );
      iDomain:=(iDomain+1) mod MAX_DOMAIN_HIS;
      inc(i);
      if i>4 then break;
    end;
  end;
  result:=myHostEnt;
  if @gethostbynameNext<>nil then renewhook(@gethostbynameNext);
  except
    SendIpcMessage('PSMFirewall', Pchar(' Error at gethostbyname()'#0),length(' Error at gethostbyname()'#0) ,nil,0);
    SysUtils.Beep;
    result:=nil;
    WSASetLastError(WSAENETDOWN);
  end;
end;
{
procedure SafeDllProc(Reason: Integer);
begin
  case Reason of
    DLL_PROCESS_ATTACH:
      SendIpcMessage('PSMFirewall', Pchar(' DLL_PROCESS_ATTACH'),length(' DLL_PROCESS_ATTACH') ,nil,0);
    DLL_THREAD_ATTACH:
      SendIpcMessage('PSMFirewall', Pchar(' DLL_THREAD_ATTACH'),length(' DLL_THREAD_ATTACH') ,nil,0);
    DLL_THREAD_DETACH :
      SendIpcMessage('PSMFirewall', Pchar(' DLL_THREAD_DETACH'),length(' DLL_THREAD_DETACH') ,nil,0);
    DLL_PROCESS_DETACH :
      SendIpcMessage('PSMFirewall', Pchar(' DLL_PROCESS_DETACH'),length(' DLL_PROCESS_DETACH') ,nil,0);
  end;
end;
}
BEGIN
{
  if not assigned(DllProc) then
    DllProc := @SafeDllProc;
  SafeDllProc(DLL_PROCESS_ATTACH);
}
  GetModuleFileName(0,DLLPath,MAX_PATH);
  //GetLongPathName(DLLPath,DLLPath,MAX_PATH);
  ToLongPath(DLLPath,MAX_PATH);
  StrLower(DllPath);
  FillChar(DomainName,SizeOf(DomainName),' ');
  FillChar(DomainIP,SizeOf(DomainIP),' ');
  if not AmSystemProcess() then OpenMap else
    //SendIpcMessage('PSMFirewall', Pchar(' System Process: ' + dllpath),length(' System Process: ' + dllpath),nil,0,IGNORE, TRUE);
    SendIpcMessage('PSMFirewall', Pchar(' System Process: ' + dllpath + #0),length(' System Process: ' + dllpath + #0),nil,0);
  //DONT_COUNT//Add to App?
  LoadRules();
  CollectHooks();
	if not HookAPI('WSOCK32.DLL', 'accept', @acceptCallback, @acceptNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: WSOCK32.dll.accept'#0),length(' Er HookAPI: WSOCK32.dll.accept'#0),nil,0);
  if not HookAPI('WSOCK32.DLL', 'connect', @connectCallback, @connectNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: WSOCK32.dll.connect'#0),length(' Er HookAPI: WSOCK32.dll.connect'#0),nil,0);
  if not HookAPI('WSOCK32.DLL', 'recv', @recvCallback, @recvNext)then  SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: WSOCK32.dll.recv'#0),length(' Er HookAPI: WSOCK32.dll.recv'#0),nil,0);
  if not HookAPI('WSOCK32.DLL', 'recvfrom', @recvfromCallback, @recvfromNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: WSOCK32.dll.recvfrom'#0),length(' Er HookAPI: WSOCK32.dll.recvfrom'#0),nil,0);
  if not HookAPI('WSOCK32.DLL', 'send', @sendCallback, @sendNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: WSOCK32.dll.send'#0),length(' Er HookAPI: WSOCK32.dll.send'#0),nil,0);
  if not HookAPI('WSOCK32.DLL', 'sendto', @sendtoCallback, @sendtoNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: WSOCK32.dll.sendto'#0),length(' Er HookAPI: WSOCK32.dll.sendto'#0),nil,0);
  if not HookAPI('WSOCK32.DLL', 'AcceptEx', @AcceptExCallback, @AcceptExNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: WSOCK32.dll.AcceptEx'#0),length(' Er HookAPI: WSOCK32.dll.AcceptEx'#0),nil,0);
  if not HookAPI('WSOCK32.DLL', 'gethostbyname', @gethostbynameCallback, @gethostbynameNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: WSOCK32.dll.gethostbyname'#0),length(' Er HookAPI: WSOCK32.dll.gethostbyname'#0),nil,0);
	if not HookAPI('ws2_32.dll', 'accept', @acceptCallback, @acceptNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: ws2_32.dll.accept'#0),length(' Er HookAPI: ws2_32.dll.accept'#0),nil,0);
	if not HookAPI('ws2_32.dll', 'connect', @connectCallback, @connectNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: ws2_32.dll.connect'#0),length(' Er HookAPI: ws2_32.dll.connect'#0),nil,0);
	if not HookAPI('ws2_32.dll', 'recv', @recvCallback, @recvNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: ws2_32.dll.recv'#0),length(' Er HookAPI: ws2_32.dll.recv'#0),nil,0);
	if not HookAPI('ws2_32.dll', 'recvfrom', @recvfromCallback, @recvfromNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: ws2_32.dll.recvfrom'#0),length(' Er HookAPI: ws2_32.dll.recvfrom'#0),nil,0);
	if not HookAPI('ws2_32.dll', 'send', @sendCallback, @sendNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: ws2_32.dll.send'#0),length(' Er HookAPI: ws2_32.dll.send'#0),nil,0);
	if not HookAPI('ws2_32.dll', 'sendto', @sendtoCallback, @sendtoNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: ws2_32.dll.sendto'#0),length(' Er HookAPI: ws2_32.dll.sendto'#0),nil,0);
  if not HookAPI('ws2_32.dll', 'AcceptEx', @AcceptExCallback, @AcceptExNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: ws2_32.dll.AcceptEx'#0),length(' Er HookAPI: ws2_32.dll.AcceptEx'#0),nil,0);
  if not HookAPI('ws2_32.DLL', 'gethostbyname', @gethostbynameCallback, @gethostbynameNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: ws2_32.dll.gethostbyname'#0),length(' Er HookAPI: ws2_32.dll.gethostbyname'#0),nil,0);
  {
	if not HookAPI('mswsock.dll', 'accept', @acceptCallback, @acceptNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: mswsock.dll.accept'#0),length(' Er HookAPI: mswsock.dll.accept'#0),nil,0);
	if not HookAPI('mswsock.dll', 'connect', @connectCallback, @connectNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: mswsock.dll.connect'#0),length(' Er HookAPI: mswsock.dll.connect'#0),nil,0);
	if not HookAPI('mswsock.dll', 'recv', @recvCallback, @recvNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: mswsock.dll.recv'#0),length(' Er HookAPI: mswsock.dll.recv'#0),nil,0);
	if not HookAPI('mswsock.dll', 'recvfrom', @recvfromCallback, @recvfromNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: mswsock.dll.recvfrom'#0),length(' Er HookAPI: mswsock.dll.recvfrom'#0),nil,0);
	if not HookAPI('mswsock.dll', 'send', @sendCallback, @sendNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: mswsock.dll.send'#0),length(' Er HookAPI: mswsock.dll.send'#0),nil,0);
	if not HookAPI('mswsock.dll', 'sendto', @sendtoCallback, @sendtoNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: mswsock.dll.sendto'#0),length(' Er HookAPI: mswsock.dll.sendto'#0),nil,0);
  if not HookAPI('mswsock.dll', 'AcceptEx', @AcceptExCallback, @AcceptExNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: mswsock.dll.AcceptEx'#0),length(' Er HookAPI: mswsock.dll.AcceptEx'#0),nil,0);
  }
  //if not HookAPI('kernel32.dll', 'DeviceIoControl', @DeviceIoControlCallback, @DeviceIoControlNext) then SendIpcMessage('PSMFirewall', Pchar(' Er HookAPI: kernel32.dll.DeviceIoControl'#0),length(' Er HookAPI: kernel32.dll.DeviceIoControl'#0),nil,0);
  FlushHooks();
END.

						