Delphi控件源码

开发平台：
Delphi

InitAndFina.pas：源码内容
							unit InitAndFina;
interface
uses SysUtils, Windows, Classes, madCodeHook;
//const  MAPFILESIZE = 8;
type
  ShareData=record
    dwTotalBytes: DWORD;
    intProcessCount: Integer;
    boNewRule: Array[0..512] of Byte;
  end;
var
  //Rules :Array of String;
  Rules :TStringList=nil;
  DllPath: array[0..MAX_PATH-1] of char='';
  //Share Memory: Total Bytes via Network.
  HMapping: THandle;
  //HMapMutex: THandle;
  PMapData: ^ShareData=nil;
  MapOpened: Boolean=False;
  MyProcessID: Integer=0;
procedure OpenMap();
procedure CloseMap();
function ToLongPath(AFileName: PChar; BufSize: Integer): PChar;
implementation
//Share Memory******************************************************************
procedure OpenMap;
var
  llInit: Boolean;
begin
  try
  MapOpened:=True;
  HMapping := CreateFileMapping(THandle($FFFFFFFF), nil, PAGE_READWRITE, 0, SizeOf(ShareData), pchar('PSMFWShareM'));
  // Check if already exists
  llInit := (GetLastError() <> ERROR_ALREADY_EXISTS);
  if (hMapping = 0) then begin
    //SendIpcMessage('PSMFirewall', Pchar(' hMapping = 0'),Length(' hMapping = 0')+1,nil,0,IGNORE, TRUE);
    SendIpcMessage('PSMFirewall', Pchar(' hMapping = 0'),Length(' hMapping = 0')+1,nil,0);
    SysUtils.Beep;
    exit;
  end;
  PMapData := MapViewOfFile(HMapping, FILE_MAP_ALL_ACCESS, 0, 0, 0);
  if PMapData = nil then begin
    CloseHandle(HMapping);
    //SendIpcMessage('PSMFirewall', Pchar(' PMapData = nil'),Length(' PMapData = nil')+1,nil,0,IGNORE, TRUE);
    SendIpcMessage('PSMFirewall', Pchar(' PMapData = nil'),Length(' PMapData = nil')+1,nil,0);
    SysUtils.Beep;
    exit;
  end;
  if (llInit) then begin//First one to create MAP
    PMapData^.dwTotalBytes:=0;  
    PMapData^.intProcessCount:=0;
  end else begin
    PMapData^.intProcessCount:=(PMapData^.intProcessCount+1) mod 512;
  end;
  MyProcessID:=PMapData^.intProcessCount;
  PMapData^.boNewRule[MyProcessID]:=PMapData^.boNewRule[0];
  except
    SendIpcMessage('PSMFirewall', Pchar(' Error at OpenMap()'),length(' Error at OpenMap()') +1,nil,0);
    SysUtils.Beep;
  end;
end;
procedure CloseMap;
begin
  MapOpened:=False;
  try
  if PMapData <> nil then begin
    PMapData^.dwTotalBytes:=0;
    PMapData^.intProcessCount:=0;
    PMapData^.boNewRule[MyProcessID]:=0;//=1: Have New Rules, =2: Stop FW, =0: FW is running and have no new rules.    
    UnMapViewOfFile(PMapData);
    PMapData:=nil;
  end;
  if HMapping <> 0 then begin
    CloseHandle(HMapping);
    HMapping:=0;
  end;
  except
    SendIpcMessage('PSMFirewall', Pchar(' Error at CloseMap()'),length(' Error at CloseMap()') +1,nil,0);  
    SysUtils.Beep;
  end;
end;
{
function LockMap:Boolean;//=True if Success or TimeOut
begin
  Result := true;
  HMapMutex := CreateMutex(nil, false, pchar('PSMFirewallShareMemMutex'));
  if HMapMutex = 0 then begin
    Result := false;
  end else begin
    if WaitForSingleObject(HMapMutex,REQUEST_TIMEOUT) = WAIT_FAILED then begin
      Result := false;
    end;
  end;
end;
procedure UnlockMap;
begin
  ReleaseMutex(HMapMutex);
  CloseHandle(HMapMutex);
end;
}
//******************************************************************************
  function FindBS(Current: PChar): PChar;
  begin
    Result := Current;
    while (Result^ <> #0) and (Result^ <> '') do
      Result := CharNext(Result);
  end;
{
function GetFullPathName(lpFileName: PChar; nBufferLength: LongWord;
  lpBuffer: PChar; var lpFilePart: PChar): LongWord; stdcall;
  external 'kernel32.dll' name 'GetFullPathNameA';
}
  function ToLongPath(AFileName: PChar; BufSize: Integer): PChar;
  var
    //CurrBS, NextBS: PChar;
    Handle: Integer;//L: Integer;
    //FindData: TWin32FindData;
    Buffer: array[0..MAX_PATH] of Char;
    GetLongPathName: function (ShortPathName: PChar; LongPathName: PChar;
      cchBuffer: Integer): Integer stdcall;
  begin
    Result := AFileName;
    Handle := GetModuleHandle('kernel32.dll');
    if Handle <> 0 then
    begin
      @GetLongPathName := GetProcAddress(Handle, 'GetLongPathNameA');
      if Assigned(GetLongPathName) and
        (GetLongPathName(AFileName, Buffer, SizeOf(Buffer)) <> 0) then
      begin
        lstrcpyn(AFileName, Buffer, BufSize);
        Exit;
      end;
    end;
    {
    if AFileName[0] = '' then
    begin
      if AFileName[1] <> '' then Exit;
      CurrBS := FindBS(AFileName + 2);  // skip server name
      if CurrBS^ = #0 then Exit;
      CurrBS := FindBS(CurrBS + 1);     // skip share name
      if CurrBS^ = #0 then Exit;
    end else
      CurrBS := AFileName + 2;          // skip drive name
    L := CurrBS - AFileName;
    lstrcpyn(Buffer, AFileName, L + 1);
    while CurrBS^ <> #0 do
    begin
      NextBS := FindBS(CurrBS + 1);
      if L + (NextBS - CurrBS) + 1 > SizeOf(Buffer) then Exit;
      lstrcpyn(Buffer + L, CurrBS, (NextBS - CurrBS) + 1);
      Handle := FindFirstFile(Buffer, FindData);
      if (Handle = -1) then Exit;
      FindClose(Handle);
      if L + 1 + strlen(FindData.cFileName) + 1 > SizeOf(Buffer) then Exit;
      Buffer[L] := '';
      lstrcpyn(Buffer + L + 1, FindData.cFileName, Sizeof(Buffer) - L - 1);
      Inc(L, strlen(FindData.cFileName) + 1);
      CurrBS := NextBS;
    end;
    lstrcpyn(AFileName, Buffer, BufSize);
    }
  end;
initialization
finalization
  SendIpcMessage('PSMFirewall', Pchar(' finalization: ' + dllpath), Length(' finalization: ' + dllpath)+1,nil,0);
  Rules.Free;
  CloseMap;
end.

						