public_unit.pas

一个简单的开机保护程序 无任何控件 全api编写 关键字 ：键盘钩子

unit Public_Unit;

interface
uses
  Windows, uConst, Messages;

type
  Screen_Size = record
    ScreenWidth: Integer;
    ScreenHeight: Integer;
  end;

  TAlpaBlend = 0..255;

  TRunFuckCAD  = procedure;
  TStopFuckCAD = procedure;
  TEnableHook  = function: Boolean; stdcall;
  TDisableHook = function: Boolean; stdcall;
  TShutDown    = function(AType: Integer): Boolean;

var
  MainHandle  : HWND;
  Msg         : TMsg;
  FontHandle  : HFONT;
  hMutexRun   : THandle;
  ButtonHandle: HWND;
  EditHandle  : HWND;
  WindowsClass: TWndClass;
  Screen      : Screen_Size;
  REG_TempKey : HKey;
  LibHandle   : THandle;
  DllFilePath : Pchar;
  OldEditProc : Longint;

  RunFuckCAD  : TRunFuckCAD;
  StopFuckCAD : TStopFuckCAD;
  EnableHook  : TEnableHook;
  DisableHook : TDisableHook;
  ShutDown    : TShutDown;

  function  CreateButton(ButtonText: PChar; ParentHandle: HWND; X, Y, Width, Height, ID: Integer): HWND;
  function  CreateEdit(EditText: PChar; ParentHandle: HWND; X, Y, Width, Height, ID: Integer): HWND;
  function  CreateBtnFont(): HFONT;
  function  GetScreenSize(): Screen_Size;
  procedure ButtonClick;
  procedure SetAlpaBlend(N: TAlpaBlend; FormID: HWND);
  function  SetMainTop(B: Boolean; FormID: HWND): Bool;
  procedure EnableTaskBar(Enable : boolean);
  function  CompareAnsiText(const S1, S2: string): Boolean;
  function  WriteRegStr(CurrentKey: Hkey; const Name, Value: string): Boolean;
  function  OpenRegKey(Root: Hkey; const Key: String; CanCreate: boolean): boolean;
  function  SetAutoRun: Boolean;
  function  ExtractFilePath(FileName: string): string;
  procedure ExtracDllFile(lpName, lpType: Pchar);
  function  LoadDll(DllName: Pchar): Boolean;

implementation

procedure ButtonClick;
var
  FEdtText: array[0..99] of Char;
begin
  SendMessage(EditHandle, WM_GETTEXT, SizeOf(FEdtText), integer(@FEdtText));
  if CompareAnsiText(FEdtText, PassWord) then
  begin
    StopFuckCAD;
    DisableHook;
    if LibHandle <> 0 then FreeLibrary(LibHandle);
    EnableTaskBar(True);
    PostQuitMessage(0);
  end else
    MessageBox(MainHandle, ERR_PASS, SYS_INFO, MB_OK or MB_ICONWARNING);
end;

function CreateBtnFont(): HFONT;
begin
  Result := CreateFont(12, 6, 0, 0, FW_EXTRALIGHT, Byte(FALSE), Byte(FALSE),
    Byte(FALSE), GB2312_CHARSET, OUT_DEFAULT_PRECIS, CLIP_DEFAULT_PRECIS,
    DEFAULT_QUALITY, DEFAULT_PITCH, FONT_NAME);
end;

function CreateButton(ButtonText: PChar; ParentHandle: HWND; X, Y, Width, Height, ID: Integer): HWND;
begin
  Result := CreateWindowEx(0, BUTTON_CLASS, ButtonText, WS_CHILD or WS_VISIBLE or BS_FLAT,
    X, Y, Width, Height, ParentHandle, ID, hInstance, nil);
  if Result <> 0 then
    SendMessage(Result, WM_SETFONT, FontHandle, 0);
end;

function CreateEdit(EditText: PChar; ParentHandle: HWND; X, Y, Width, Height, ID: Integer): HWND;
begin
  Result := CreateWindowEx(0, EDIT_CLASS, EditText, WS_CHILD or
                          WS_VISIBLE      {or BS_FLAT}
                          or WS_BORDER    {显示边框}
                          or ES_NOHIDESEL {高亮选择区即使在失去焦点的时候也仍然显示}
                          or ES_PASSWORD
                          { or ES_NUMBER   {只接收数字}
                          or ES_LOWERCASE   {转换为小写}
                          or ES_AUTOHSCROLL,{自动向后滚动}
                     X, Y, Width, Height, ParentHandle, ID, hInstance, nil);
  if Result <> 0 then
    SendMessage(Result, WM_SETFONT, FontHandle, 0);
end;

function GetScreenSize(): Screen_Size;
begin
  Result.ScreenWidth := GetSystemMetrics(SM_CXFULLSCREEN);
  Result.ScreenHeight := GetSystemMetrics(SM_CYFULLSCREEN);
end;

procedure EnableTaskBar(Enable : boolean);
var
  hTaskBarWindow : HWnd;
begin
  hTaskBarWindow := FindWindow(TrayWindow, nil);
  if hTaskBarWindow <> 0 then EnableWindow(hTaskBarWindow,Enable);
  if Enable then
    ShowWindow(hTaskBarWindow, SW_SHOW)
  else ShowWindow(hTaskBarWindow, SW_HIDE);
end;

function SetMainTop(B: Boolean; FormID: HWND): Bool;
begin
  if B then
    Result := SetWindowPos(FormID, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE)
  else
    Result := SetWindowPos(FormID, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE or SWP_NOSIZE);
end;

procedure SetAlpaBlend(N: TAlpaBlend; FormID: HWND);
begin
  SetWindowLong(FormID, GWL_EXSTYLE, WS_EX_LAYERED);            
  SetLayeredWindowAttributes(FormID, 0, N, LWA_ALPHA);
end;

function CompareAnsiText(const S1, S2: string): Boolean;
begin
  Result := CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, PChar(S1), -1, PChar(S2), -1) = 2;
end;

function OpenRegKey(Root: Hkey; const Key: String; CanCreate: boolean): boolean;
var
  Disposition: Integer;
begin
  REG_TempKey := 0;
  if not CanCreate or (Key = '') then
    Result := RegOpenKeyEx(Root, PChar(Key), 0,
                    KEY_ALL_ACCESS, REG_TempKey) = ERROR_SUCCESS
  else
    Result := RegCreateKeyEx(Root, PChar(Key), 0, nil,
                    REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS,
                    nil, REG_TempKey, @Disposition) = ERROR_SUCCESS;
end;

function WriteRegStr(CurrentKey: Hkey; const Name, Value: string): Boolean;
begin
  Result := RegSetValueEx(CurrentKey, PChar(Name), 0, REG_SZ,
                      PChar(Value), Length(Value) + 1) = ERROR_SUCCESS;
end;

function  SetAutoRun: Boolean;
begin
  Result := False;
  if OpenRegKey(HKEY_LOCAL_MACHINE, ID_REG_RUN, True) then
  begin
    Result := WriteRegStr(REG_TempKey, ID_REG_NAME, ParamStr(0));
    RegCloseKey(REG_TempKey);
  end;
end;

function ExtractFilePath(FileName: string): string;
begin
  Result := '';
  while ((Pos('\', FileName) <> 0) or (Pos('/', FileName) <> 0)) do
  begin
    Result := Result + Copy(FileName, 1, 1);
    Delete(FileName, 1, 1);
  end;
end;

procedure ExtracDllFile(lpName, lpType: Pchar);
var
  ResourcePointer: pchar;
  ResourceLocation: HRSRC;
  ResourceSize, BytesWritten: Longword;
  ResDataHandle, FileHandle: THandle;
begin
  if True then
  begin
    ResourceLocation := FindResource(HInstance, lpName, lpType);
    if ResourceLocation <> 0 then
    begin
      ResourceSize := SizeofResource(HInstance, ResourceLocation);
      if ResourceSize <> 0 then
      begin
        ResDataHandle := LoadResource(HInstance, ResourceLocation);
        if ResDataHandle <> 0 then
        begin
          ResourcePointer := LockResource(ResDataHandle);
          if ResourcePointer <> nil then
          begin
            FileHandle := CreateFile(DllFilePath, GENERIC_WRITE, FILE_SHARE_WRITE, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
            if FileHandle <> INVALID_HANDLE_VALUE then
            begin
              WriteFile(FileHandle, ResourcePointer^, ResourceSize, BytesWritten, nil);
              CloseHandle(FileHandle);
            end;
          end;
        end;
      end;
    end;
  end;
end;

function  LoadDll(DllName: Pchar): Boolean;
begin
  Result := False;
  LibHandle := LoadLibrary(DllName) ;
  if LibHandle <> 0 then
  begin
    @RunFuckCAD := GetProcAddress(LibHandle, 'RunFuckCAD');
    @StopFuckCAD := GetProcAddress(LibHandle, 'StopFuckCAD');
    @EnableHook := GetProcAddress(LibHandle, 'EnableHook');
    @DisableHook := GetProcAddress(LibHandle, 'DisableHook');
    @ShutDown := GetProcAddress(LibHandle, 'ShutDown');
    Result := True;
  end;
end;

end.