“序列号输入助手”源代码

2019-11-18 17:58:02

字体：大中小

来源：转载

供稿：网友

/////////////////////////////////////////////////////////
//        SnInput                                      //
//                                                     //
//                            作者:黄展宏              //
//                            QQ号:309654973           //
//                            创建于:2005/06/23        //
//                            修改于:2005/06/29        //
/////////////////////////////////////////////////////////

PRogram SnInput;

{$APPTYPE GUI}
{$I-}

uses
  Windows,
  Messages,
  SysUtils;

var
  atom: Integer = 0;
  hInst: Integer;
  wc: TWndClassEx;
  Msg: TMsg;

  hFont: Integer = 0;
  hMutex: Integer;

  hWnd: Integer;
  hEdit: Integer;
  hCheckBox: Integer;
  hTmpWnd: Integer;

const
  ID_CHECKBOX = 100;
  STR_INTERNALNAME = 'SnInputapplication';
  STR_CHECKBOX = '将“-”（杠号）转为跳格键（Tab）。';
  STR_HOTKEY = 'MyHotKey_OrochiHuang_2005.6.18';
  STR_PRODUCT = '序列号输入助手 V0.1';
  STR_TipS = (#13#10 +
    '使用说明：' + #13#10 +
    '1、复制序列号。'#13#10 +
    '2、将光标定位到序列号输入处。'#13#10 +
    '3、按F10键。'#13#10 + #13#10 +
    '“将‘-’（杠号）转为跳格键（Tab）”功能说明：' + #13#10 +
    '　　因为有一些程序当输完一段序列号后，不会自动跳往下一格继续输入，导致把全部注册码输入在一个序列号段里，' +
    '遇到这个种情况的话勾选它就对啦！' + #13#10 + #13#10 +
    '作者：黄展宏' + #13#10 +
    'Email：orochi_huang@126.com');

procedure MySendKeys(Keys: PChar);
  procedure SendKeyDown(VKey: Byte);
  var ScanCode: Byte;
  begin
    ScanCode := Lo(MapVirtualKey(VKey, 0));
    keybd_event(VKey, ScanCode, 0, 0);
  end;

  procedure SendKeyUp(VKey: Byte);
  var ScanCode: Byte;
  begin
    ScanCode := Lo(MapVirtualKey(VKey, 0));
    keybd_event(VKey, ScanCode, KEYEVENTF_KEYUP, 0);
  end;

  function BitSet(BitTable, BitMask: Byte): Boolean;
  begin
    Result := ByteBool(BitTable and BitMask);
  end;

var
  L: Word;
  I: Word;
  MKey: Word;
  ScanCode: Byte;
const
  VKKEYSCANSHIFTON = $01;
  VKKEYSCANCTRLON = $02;
  VKKEYSCANALTON = $04;
begin
  L := StrLen(Keys);

  if L = 0 then Exit;

  for I := 0 to L - 1 do
  begin
    MKey := vkKeyScan(Keys[I]);
    if MKey <> $FFFF then
    begin
      ScanCode := Hi(MKey);
      if BitSet(ScanCode, VKKEYSCANSHIFTON) then SendKeyDown(VK_SHIFT);
      if BitSet(ScanCode, VKKEYSCANCTRLON) then SendKeyDown(VK_CONTROL);
      if BitSet(ScanCode, VKKEYSCANALTON) then SendKeyDown(VK_MENU);
      SendKeyDown(MKey);
      SendKeyUp(MKey);
      if BitSet(ScanCode, VKKEYSCANSHIFTON) then SendKeyUp(VK_SHIFT);
      if BitSet(ScanCode, VKKEYSCANCTRLON) then SendKeyUp(VK_CONTROL);
      if BitSet(ScanCode, VKKEYSCANALTON) then SendKeyUp(VK_MENU);
      Sleep(15);
    end;
  end;

end;

procedure HotKey(hWnd: Integer; state: Boolean);
begin

  if state then
  begin
    atom := GlobalFindATOM(STR_HOTKEY);

    if atom = 0 then atom := GlobalAddATOM(STR_HOTKEY);

    RegisterHotKey(hWnd, atom, 0, VK_F10);
  end
  else begin
    if atom <> 0 then
    begin
      UnregisterHotKey(hWnd, atom);
      GlobalDeleteATOM(atom);
      atom := 0;
    end;
  end;
end;

function WndProc(hWnd: Integer; uMsg: Cardinal;
  wParam, lParam: Integer): LRESULT; stdcall;
var
  hData: Integer;
  Keystr: string;
  Position: Byte;
  rc: TRect;

begin
  Result := 0;
  case uMsg of
    WM_CTLCOLORSTATIC:
      begin
        if lParam = hEdit then
        begin
          SetBkColor(wParam, $FFFFFF);
          Result := GetStockObject(WHITE_BRUSH);
        end;
      end;

    WM_CREATE:
      begin
        HotKey(hWnd, True);
        GetClientRect(hWnd, rc);
        hEdit := CreateWindowEx(WS_EX_CLIENTEDGE, 'EDIT', STR_TIPS,
          WS_BORDER or WS_CHILD or WS_VISIBLE or ES_READONLY or ES_MULTILINE or
          WS_VSCROLL,
          0, 30, rc.Right, rc.Bottom - 30, hWnd, 0, hInst, nil);

        hCheckBox := CreateWindowEx(0, 'BUTTON', STR_CHECKBOX, WS_VISIBLE or
          WS_CHILD or BS_AUTOCHECKBOX,
          10, 10, 300, 20, hWnd, ID_CHECKBOX, hInst, nil);

        hFont := CreateFont(12, 0, 0, 0, 0, 0, 0, 0,
          DEFAULT_CHARSET, 0, 0, 0, 0, '宋体');

        if hFont <> 0 then
        begin
          SendMessage(hEdit, WM_SETFONT, hFont, 0);
          SendMessage(hCheckBox, WM_SETFONT, hFont, 0);
        end;

      end;

    WM_HOTKEY:
      begin
        OpenClipboard(hWnd);
        hData := GetClipboardData(CF_TEXT);

        if hData <> 0 then
        begin
          Keystr := StrPas(PChar(GlobalLock(hData)));
          Position := Pos('-', Keystr);

          while Position > 0 do
          begin

            if SendMessage(hCheckBox, BM_GETCHECK, 0, 0) <> 0 then
              Keystr[Position] := Char(VK_TAB)
            else
              Delete(KeyStr, Position, sizeof(keystr[Position]));

            Position := Pos('-', Keystr);
          end;

          MySendKeys(PChar(KeyStr));
          GlobalUnlock(hData);
        end;
        CloseClipboard;

      end;

    WM_DESTROY:
      begin
        if hFont <> 0 then
          DeleteObject(hFont);

        HotKey(hWnd, False);
        PostQuitMessage(0);
      end;

  else
    Result := DefWindowProc(hWnd, uMsg, wParam, lParam);
  end;

end;

begin
  hMutex := CreateMutex(nil, True, STR_PRODUCT);

  if GetLastError = ERROR_ALREADY_EXISTS then
  begin
    hTmpWnd := FindWindow(STR_INTERNALNAME, nil);
    if hTmpWnd <> 0 then
    begin
      if IsIconIc(hTmpWnd) then
        ShowWindow(hTmpWnd, SW_NORMAL);

      SetForegroundWindow(hTmpWnd);
      ShowWindow(hTmpWnd, SW_SHOW);
    end;
    Exit;
  end;

  hInst := hInstance;
  FillChar(wc, SizeOf(wc), 0);

  with wc do
  begin
    cbSize := SizeOf(wc);
    style := CS_HREDRAW or CS_VREDRAW;
    lpfnWndProc := @WndProc;
    hInstance := hInst;
    hIcon := LoadIcon(0, IDI_APPLICATION);
    hCursor := LoadCursor(0, IDC_ARROW);
    hbrBackground := GetSysColorBrush(COLOR_BTNFACE);
    lpszClassName := STR_INTERNALNAME;
  end;

  if RegisterClassEx(wc) = 0 then Exit;

  hWnd := CreateWindowEx(0, wc.lpszClassName, STR_PRODUCT,
    (*WS_OVERLAPPED or *)WS_MINIMIZEBOX or WS_CAPTiON or WS_SYSMENU,
    Integer(CW_USEDEFAULT), Integer(CW_USEDEFAULT), 320, 250,
    0, 0, hInst, nil);

  if hWnd = 0 then Exit;

  ShowWindow(hWnd, SW_SHOW);
  UpdateWindow(hWnd);

  repeat
    if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
    begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end
    else begin
      ;
    end;
  until Msg.message = WM_QUIT;

  ReleaseMutex(hMutex);
  CloseHandle(hMutex);

end.

上一篇：Windows2000系统进程总列表(手工清木马时候有用)

下一篇：获得Windows的版本信息

学习交流

索泰发布一款GTX 1070 Mini迷你版本:小机

索泰发布一款GTX 1070 Mini迷你版本:小机箱大爱...

热门图片

猜你喜欢的新闻

猜你喜欢的关注