Wie kann ich en Edit Feld schützen

[Wishmaster]

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.