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：
[email protected]');
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.
