psmfirew.dpr

一款防火墙源码

{
Injected DLL for PSM Firewall.
(C) 2003 PSMKorea, http://www.psmkorea.co.kr
Written by DoDucTruong, [e-mail]
}

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='SOFTWARE\PSMFirewall';

  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;