|
![]() |
|
Registriert seit: 14. Sep 2002 Ort: Steinbach, MB, Canada 301 Beiträge Delphi XE2 Architect |
#1
Hi
Ich habe ne Lösung gefunden (Komponente) allerdings sind da noch feiler die ich nicht finden bzw. lösen kann. Feileich kann eine mir weiterhelfen? Die Komponente wird mit einem TEdit gekoppelt Der feiler ist jetzt, wen die Zeichen Länge im Edit Feld = 1 ist und man den geheim string einer Memo oder Label zuweist is die Länge der Zeichen = 2. Exemplar. Edit1.text = t Label.Caption = tt Der zweite feiler er erkennt die shift taste nicht, nur kleine Buchstaben
Delphi-Quellcode:
unit JB_Hookedit;
interface uses Messages, SysUtils, ClipBrd, Classes, StdCtrls, ExtCtrls; type THookEvent = procedure(nCode: Integer; wParam, lParam: Integer) of object; TJB_HookEdit = class(TComponent) private FHookEdit : TCustomEdit; FActive : Boolean; FOnGetMsg : THookEvent; FOnWndProc : THookEvent; FOnWndProcRet : THookEvent; function GetSecretChar: Char; function GetSecretTextMaxLength: Integer; procedure SetHookEdit(const Value: TCustomEdit); procedure SetSecretChar(const Value: Char); procedure SetSecretTextMaxLength(const Value: Integer); procedure SetActive(const Value: Boolean); procedure SetOnGetMsg(const Value: THookEvent); procedure SetOnWndProc(const Value: THookEvent); procedure SetOnWndProcRet(const Value: THookEvent); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; function SecretText: string; overload; function SecretText(AEdit: TCustomEdit): string; overload; procedure Clear; procedure RegisterHooks; property Active: Boolean read FActive write SetActive; published property HookEdit: TCustomEdit read FHookEdit write SetHookEdit; property SecretChar: Char read GetSecretChar write SetSecretChar; property SecretTextMaxLength: Integer read GetSecretTextMaxLength write SetSecretTextMaxLength; property OnGetMsg: THookEvent read FOnGetMsg write SetOnGetMsg; property OnWndProc: THookEvent read FOnWndProc write SetOnWndProc; property OnWndProcRet: THookEvent read FOnWndProcRet write SetOnWndProcRet; end; procedure Register; implementation uses Windows; var FClipBoard : TClipBoard = nil; FSecretLines : TStringList = nil; FKeyState : TKeyBoardState; FCTRLDown : Boolean = false; FInitCBText : string; // CB = ClipBoard FHookWnd : HWND = 0; FHook_GetMsg : HHOOK = 0; FHook_WndProc : HHOOK = 0; FHook_WndProcRet : HHOOK = 0; FSecretLineID : Integer = 0; FSecretChar : Char = '*'; FSecretTextMaxLength : Integer = 0; FMX_HookEdit : TJB_HookEdit = nil; procedure RegHooks; forward; procedure UnregHooks; forward; function ProcessStr(var S: string; MaxLength: Integer): Boolean; forward; procedure CleanupString(var S: string); forward; procedure GetStartEndSel(var StartSel, EndSel: Integer); forward; { Create } constructor TJB_HookEdit.Create(AOwner: TComponent); begin inherited Create(AOwner); // if (FMX_HookEdit <> nil) then begin if (FMX_HookEdit.Owner <> nil) then FMX_HookEdit.Owner.RemoveComponent(FMX_HookEdit); FMX_HookEdit.Free; end; // // FPreventPaste:= true; // FMX_HookEdit := Self; // FActive := false; FHookEdit := nil; FSecretLineID := -1; FSecretChar := '*'; FSecretTextMaxLength := 0; // if (FSecretLines = nil) then FSecretLines := TStringList.Create; if (FClipBoard = nil) then FClipBoard := TClipBoard.Create; end; { Password_Edit.Font.Charset := 2; Password_Edit.PasswordChar := 'l'; } { Destroy } destructor TJB_HookEdit.Destroy; begin try UnregHooks; if (FClipBoard <> nil) then begin FClipBoard.Free; FClipBoard:= nil end; if (FSecretLines <> nil) then begin FSecretLines.Free; FSecretLines := nil end; // FMX_HookEdit := nil; finally inherited; end; end; { RegisterHooks } procedure TJB_HookEdit.RegisterHooks; begin RegHooks; end; { Clear } procedure TJB_HookEdit.Clear; var I : Integer; begin FInitCBText := ''; if (FSecretLines <> nil) then for I := 0 to FSecretLines.Count - 1 do FSecretLines[I] := ''; end; { SecretText - I } function TJB_HookEdit.SecretText: string; begin Result := SecretText(FHookEdit); end; function TJB_HookEdit.SecretText(AEdit: TCustomEdit): string; var I, IMax : Integer; VEditFound : Boolean; begin Result := ''; if (not (AEdit is TCustomEdit)) or (FSecretLines = nil) then Exit; // if (FSecretLines.Count > 0) then begin I := -1; IMax := FSecretLines.Count -1 ; repeat Inc(I); VEditFound := (TCustomEdit(FSecretLines.Objects[I]) = AEdit); if VEditFound then Result := FSecretLines[I]; until (I = IMax) or VEditFound; end; end; { GetSecretChar } function TJB_HookEdit.GetSecretChar: Char; begin Result := FSecretChar; end; { GetSecretTextMaxLength } function TJB_HookEdit.GetSecretTextMaxLength: Integer; begin Result := FSecretTextMaxLength; end; { SetHookEdit} procedure TJB_HookEdit.SetHookEdit(const Value: TCustomEdit); var I, IMax : Integer; VEditFound : Boolean; VText : string; begin if (FHookEdit <> Value) then begin FHookEdit := Value; FHookWnd := 0; FSecretLineID := -1; // if (FHookEdit <> nil) then begin FHookWnd := FHookEdit.Handle; VEditFound := false; // if (FSecretLines <> nil) then begin if (FSecretLines.Count > 0) then begin I := -1; IMax := FSecretLines.Count - 1; repeat Inc(I); VEditFound := TCustomEdit(FSecretLines.Objects[I]) = FHookEdit; until (I = IMax) or VEditFound; if VEditFound then FSecretLineID := I; end; // if (not VEditFound) then begin FSecretLineID := FSecretLines.Count; VText := FHookEdit.Text; FSecretLines.AddObject(VText, FHookEdit); // for I := 1 to Length(VText) do VText[I] := SecretChar; FHookEdit.Text := VText; end; end; end; end; end; { SetSecretChar } procedure TJB_HookEdit.SetSecretChar(const Value: Char); begin FSecretChar := Value; end; { SetSecretTextMaxLength } procedure TJB_HookEdit.SetSecretTextMaxLength(const Value: Integer); begin FSecretTextMaxLength := Value; end; { SetActive } procedure TJB_HookEdit.SetActive(const Value: Boolean); begin FActive := Value and (not (csDesigning in ComponentState)); if FActive then RegHooks else UnregHooks; end; { SetSecretLine } procedure SetSecretLine(ALineID: Integer; const ALine: string); var VLine : string; begin if (FSecretLines <> nil) and (ALineID >= 0) and (ALineID < FSecretLines.Count) then begin VLine := ALine; CleanupString(VLine); FSecretLines[ALineID] := VLine; end; end; { ProcessStr } function ProcessStr(var S: string; MaxLength: Integer): Boolean; var VLen : Integer; begin VLen := 0; if (S <> '') and (MaxLength > 0) then begin CleanupString(S); VLen := Length(S) - MaxLength; if (VLen > 0) then Delete(S, MaxLength + 1, VLen); end; Result := (VLen <= 0); end; { CleanupString } procedure CleanupString(var S: string); var I, IMax : Integer; VChar : Char; begin IMax := Length(S); for I := IMax downto 1 do begin if (S[I] = #$0A) then begin if (I = 1) then VChar := #0 else VChar := S[I - 1]; if (VChar <> #$0D) then Delete(S, I, 1); end; // if (S[I] = #$0D) then begin if (I = IMax) then VChar := #0 else VChar := S[I + 1]; if (VChar <> #$0A) then Delete(S, I, 1); end; end; end; { GetStartEndSel } procedure GetStartEndSel(var StartSel, EndSel: Integer); var VResult : Integer; begin if IsWindow(FHookWnd) then VResult := SendMessage(FHookWnd, EM_GETSEL, 0, 0) else VResult := -1; // if (VResult <> -1) then begin StartSel := (VResult and $0000FFFF); EndSel := (VResult and $FFFF0000) shr 8; // original 16 end else begin StartSel := 0; EndSel := 0; end; end; { GetMsgProc } function GetMsgProc(nCode: Integer; wParam, lParam: Integer): LResult; stdcall; { process messages: WM_KEYUP VK_CONTROL WM_KEYDOWN VK_CONTROL VK_BACK VK_DELETE VK_ENTER WM_CHAR } const VChar = $38; var VMsg : PMsg; VMess : Cardinal; VWndValid : Boolean; VStartSel : Integer; VEndSel : Integer; VKeyState : TKeyBoardState; VVirtKey : Integer; VScanCode : Integer; VCharCode : array[0..3] of Char; VRetVal : Smallint; VKBLayout : HKL; S : string; begin Result := 0; // if (nCode < 0) then Result := CallNextHookEx(FHook_GetMsg, nCode, wParam, lParam) else if (nCode = HC_ACTION) then begin VMsg := PMsg(Pointer(lParam)); VWndValid := IsWindow(FHookWnd) and (VMsg.hwnd = FHookWnd); if VWndValid and (FSecretLines <> nil) and (FSecretLineID >= 0) and (FSecretLineID < FSecretLines.Count) then begin S := FSecretLines[FSecretLineID]; VMess := VMsg.message; case VMess of // WM_KEYUP WM_KEYUP : begin VVirtKey := VMsg.wParam; case VVirtKey of // VK_CONTROL VK_CONTROL : begin FCTRLDown := false; end; end; end; // WM_KEYDOWN WM_KEYDOWN : begin GetKeyBoardState(FKeyState); // VVirtKey := VMsg.wParam; case VVirtKey of // VK_CONTROL VK_CONTROL : begin FCTRLDown := true; end; // VK_BACK VK_BACK : begin GetStartEndSel(VStartSel, VEndSel); Delete(S, VStartSel, VEndSel - VStartSel + 1); end; // VK_DELETE VK_DELETE : begin GetStartEndSel(VStartSel, VEndSel); if (VEndSel = VStartSel) then Delete(S, VStartSel + 1, VEndSel - VStartSel + 1) else Delete(S, VStartSel + 1, VEndSel - VStartSel); end; // VK_RETURN VK_RETURN : begin GetStartEndSel(VStartSel, VEndSel); Delete(S, VStartSel + 1, VEndSel - VStartSel); end; // VK_... else begin if not FCTRLDown then begin GetKeyBoardState(VKeyState); VScanCode := VMsg.lParam and $FF0000; ZeroMemory(@VCharCode, SizeOf(VCharCode)); VKBLayout := GetKeyBoardLayout(GetCurrentThreadID); VRetVal := ToASCIIEx(VVirtKey, VScanCode, VKeyState, @VCharCode, 0, VKBLayout); // if (VRetVal <> 0) then begin GetStartEndSel(VStartSel, VEndSel); Delete(S, VStartSel + 1, VEndSel - VStartSel); Insert(VCharCode, S, VStartSel + 1); // if ProcessStr(S, FSecretTextMaxLength) then begin VKeyState[VK_SHIFT] := 0; SetKeyBoardState(VKeyState); VMsg.wParam := VChar; end else VMsg.wParam := 0 end; end; end; end; end; // WM_CHAR WM_CHAR : begin case VMsg.wParam of $09 : S := S + #09; $0D : S := S + #$0D#$0A; VChar : VMsg.wParam := Ord(FSecretChar); end; // SetKeyBoardState(FKeyState); end; end; // SetSecretLine(FSecretLineID, S); end; end; // if (FMX_HookEdit <> nil) and Assigned(FMX_HookEdit.FOnGetMsg) then FMX_HookEdit.FOnGetMsg(nCode, wParam, lParam); end; { CallWndProc } function CallWndProc(nCode: Integer; wParam, lParam: Integer): LResult; stdcall; { process messages: WM_PASTE WM_CLEAR WM_CUT } var VStruct : PCWPSTRUCT; VMess : Cardinal; VWndValid : Boolean; VStartSel : Integer; VEndSel : Integer; VCBText : string; VCBBuffSize : Integer; S : string; begin Result := 0; // if (nCode < 0) then Result := CallNextHookEx(FHook_GetMsg, nCode, wParam, lParam) else if (nCode = HC_ACTION) then begin VStruct := PCWPSTRUCT(Pointer(lParam)); VWndValid := IsWindow(FHookWnd) and (VStruct.hwnd = FHookWnd); if VWndValid and (FClipBoard <> nil) and (FSecretLines <> nil) and (FSecretLineID >= 0) and (FSecretLineID < FSecretLines.Count) then begin S := FSecretLines[FSecretLineID]; VMess := VStruct.message; // case VMess of // WM_PASTE WM_PASTE : begin FInitCBText := FClipBoard.AsText; VCBBuffSize := Length(FInitCBText); SetLength(VCBText, VCBBuffSize); FillMemory(PChar(VCBText), VCBBuffSize, Ord(FSecretChar)); FClipBoard.SetTextBuf(PChar(VCBText)); // GetStartEndSel(VStartSel, VEndSel); Delete(S, VStartSel + 1, VEndSel - VStartSel); Insert(FInitCBText, S, VStartSel + 1); // ProcessStr(S, FSecretTextMaxLength); end; // WM_CLEAR, WM_CUT WM_CLEAR, WM_CUT : begin GetStartEndSel(VStartSel, VEndSel); if (VEndSel = VStartSel) then Delete(S, VStartSel + 1, VEndSel - VStartSel + 1) else Delete(S, VStartSel + 1, VEndSel - VStartSel); end; end; // SetSecretLine(FSecretLineID, S); end; end; // if (FMX_HookEdit <> nil) and Assigned(FMX_HookEdit.FOnWndProc) then FMX_HookEdit.FOnWndProc(nCode, wParam, lParam); end; { CallWndProcRet } function CallWndProcRet(nCode: Integer; wParam, lParam: Integer): LResult; stdcall; { process messages: WM_PASTE } var VStruct : PCWPRETSTRUCT; VMess : Cardinal; VWndValid : Boolean; begin Result := 0; if (nCode < 0) then Result := CallNextHookEx(FHook_GetMsg, nCode, wParam, lParam) else if (nCode = HC_ACTION) then begin VStruct := PCWPRETSTRUCT(Pointer(lParam)); VWndValid := IsWindow(FHookWnd) and (VStruct.hwnd = FHookWnd); if VWndValid and (FClipBoard <> nil) then begin VMess := VStruct.message; // case VMess of // WM_PASTE WM_PASTE : begin FClipBoard.SetTextBuf(PChar(FInitCBText)); end; end; end; end; // if (FMX_HookEdit <> nil) and Assigned(FMX_HookEdit.FOnWndProcRet) then FMX_HookEdit.FOnWndProcRet(nCode, wParam, lParam); end; { RegHook_GetMsg } procedure RegHook_GetMsg; begin if (FHook_GetMsg = 0) then FHook_GetMsg := SetWindowsHookEx(WH_GETMESSAGE, @GetMsgProc, HInstance, GetCurrentThreadID) else begin if UnhookWindowsHookEx(FHook_GetMsg) then FHook_GetMsg := SetWindowsHookEx(WH_GETMESSAGE, @GetMsgProc, HInstance, GetCurrentThreadID) end; end; { UnregHook_GetMsg } procedure UnregHook_GetMsg; begin if (FHook_GetMsg <> 0) then if UnhookWindowsHookEx(FHook_GetMsg) then FHook_GetMsg := 0; end; { RegHook_WndProc } procedure RegHook_WndProc; begin if (FHook_WndProc = 0) then FHook_WndProc := SetWindowsHookEx(WH_CALLWNDPROC, @CallWndProc, HInstance, GetCurrentThreadID) else begin if UnhookWindowsHookEx(FHook_WndProc) then FHook_WndProc := SetWindowsHookEx(WH_CALLWNDPROC, @CallWndProc, HInstance, GetCurrentThreadID) end; end; { UnregHook_WndProc } procedure UnregHook_WndProc; begin if (FHook_WndProc <> 0) then if UnhookWindowsHookEx(FHook_WndProc) then FHook_WndProc := 0; end; { RegHook_WndProcRet } procedure RegHook_WndProcRet; begin if (FHook_WndProcRet = 0) then FHook_WndProcRet := SetWindowsHookEx(WH_CALLWNDPROCRET, @CallWndProcRet, HInstance, GetCurrentThreadID) else begin if UnhookWindowsHookEx(FHook_WndProcRet) then FHook_WndProcRet := SetWindowsHookEx(WH_CALLWNDPROCRET, @CallWndProcRet, HInstance, GetCurrentThreadID) end; end; { UnregHook_WndProcRet } procedure UnregHook_WndProcRet; begin if (FHook_WndProcRet <> 0) then if UnhookWindowsHookEx(FHook_WndProcRet) then FHook_WndProcRet := 0; end; { RegHooks} procedure RegHooks; begin RegHook_WndProcRet; RegHook_WndProc; RegHook_GetMsg; end; { UnregHooks } procedure UnregHooks; begin UnregHook_GetMsg; UnregHook_WndProc; UnregHook_WndProcRet; end; { SetOnGetMsg } procedure TJB_HookEdit.SetOnGetMsg(const Value: THookEvent); begin FOnGetMsg := Value; end; { SetOnWndProc } procedure TJB_HookEdit.SetOnWndProc(const Value: THookEvent); begin FOnWndProc := Value; end; { SetOnWndProcRet } procedure TJB_HookEdit.SetOnWndProcRet(const Value: THookEvent); begin FOnWndProcRet := Value; end; procedure Register; begin RegisterComponents('JB Security', [TJB_HookEdit]); end; end. |
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |