/////////////////////////////////////////////////////////
// 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_[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 .