Die hier aufgeführten Funktionen und Prozeduren sind bei meinen Projekten "angefallen" und wurden von mir in einer Unit znarf gesammelt. In der unten stehenden Liste sind die einzelnen Routinen aufgeführt und können gezielt angesprungen werden.

Wer sich an der fehlenden Untergliederung stört(ist beim Konvertieren ins HTML-Format auf der Strecke geblieben), kann sich die Unit auch runterladen (ist generell empfehlenswert, da diese häufiger aktualisiert wird).

Download starten znarf.pas 22  KB
Download starten znarf.zip 6 KB


Stringroutinen
In einem String einen Teilstring durch einen anderen ersetzen
Ascii-String in Ansi umwandeln
Ansi-String in Ascii umwandeln
Ermitteln, ob String in einer mit ";" getrennten "Liste"
Alle Zeichen eines Strings ab einer Position wiedergeben
Alle Leerzeichen und Tabs am Ende des Stringes entfernen

Zahlenroutinen
Testen, ob String ein Integer ist
Prüfen, ob x Teiler von y ist
Einen Hex-String in Integer umwandeln
Das x-te Quadrat von y ermitteln
Schnell ermitteln, ob a < b < c
Boolean in Integer umwandeln (und zurück)
Integer in String mit führenden Nullen umwandeln

Dateiroutinen
Test, ob ein Dateiname zulässig ist
Test, ob ein Verzeichnisname zulässig ist
Dateinamen ohne Endung ermitteln
aus einer file://-URL den Dateinamen extrahieren
Mehrere Dateien kopieren oder löschen

Windowsroutinen
Windowsversion ermitteln
Windowsverzeichnis ermitteln
Ermitteln, ob eine Anwendung ausgeführt wird
Namen des aktuellen Windowsusers ermitteln
Windows beenden (auch unter NT)
Überprüfen, ob Schriftart installiert

Sonstiges
Eine Pause realisieren
Umrechnung Pixel in Zentimeter und zurück
Einfache Verschlüsselungsroutine
Mausklick simulieren
Tastendruck simulieren
Wird Strg, Shift oder Alt für eine Taste benötigt?
Num-, Caps- oder Scrollock an und ausschalten

Stringroutinen

In einem String einen Teilstring durch einen anderen ersetzen:

function Replace(const OrgStrng : string; FromStrng, ToStrng : String): String; // ersetzt  in OrgStrg FromStrg durch ToStrng
var x : Word;
Label 1;
begin
Result := OrgStrng;
1: // Label-Marke
x := Pos(FromStrng, Result);
if x = 0 then exit; // kein (weiteres) Vorkommen von FromStrng
Delete(Result, x, Length(FromStrng));
Insert(ToStrng, Result, x);
goto 1;
end;

Ascii-String in Ansi umwandeln

function AsciiToAnsi(const Zeile: string): String;
var
FPos : Integer; {Position, an der der Umlaut steht}
x : Integer; {für FOR-Schleife}
UmlautASCII, UmlautANSI : Char; {jeweiliger Umlaut}
KonvZeile : String; {die konvertierte Zeile}
const UmlautASCIIList : String = '„”áŽ™š'; {Liste der ASCII-Umlaute}
UmlautANSIList : String = 'äöüßÄÖÜ'; {Liste der ANSI-Umlaute}
Label 1, 2;
begin
KonvZeile := Zeile;
For x := 1 to 7 do {7 Umlaute}
begin
UmlautASCII := UmlautASCIIList[x]; {der jeweilige Umlaut aus der Liste}
UmlautANSI := UmlautANSIList[x]; {wird zugewiesen}
1: FPos := Pos(UmlautASCII, KonvZeile);
if FPos = 0 then goto 2; {wenn kein (weiterer) Umlaut in Zeile}
KonvZeile[FPos] := UmlautANSI;
goto 1; {Umlaut mehrmals in Zeile ?}
2: end;
Result := KonvZeile;
end;

Ansi-String in Ascii umwandeln

function AnsiToAscii(const Zeile: string): String;
var
FPos : Integer; {Position, an der der Umlaut steht}
x : Integer; {für FOR-Schleife}
UmlautASCII, UmlautANSI : Char; {jeweiliger Umlaut}
KonvZeile : String; {die konvertierte Zeile}
const UmlautASCIIList : String = '„”áŽ™š'; {Liste der ASCII-Umlaute}
UmlautANSIList : String = 'äöüßÄÖÜ'; {Liste der ANSI-Umlaute}
Label 1, 2;
begin
KonvZeile := Zeile;
For x := 1 to 7 do {7 Umlaute}
begin
UmlautASCII := UmlautASCIIList[x]; {der jeweilige Umlaut aus der Liste}
UmlautANSI := UmlautANSIList[x]; {wird zugewiesen}
1: FPos := Pos(UmlautAnsi, KonvZeile);
if FPos = 0 then goto 2; {wenn kein (weiterer) Umlaut in Zeile}
KonvZeile[FPos] := UmlautAscii;
goto 1; {Umlaut mehrmals in Zeile ?}
2: end;
Result := KonvZeile;
end;

Ermitteln, ob String in einer mit beliebigem Zeichen getrennten "Liste" enthalten ist

function StrOfList(const OrgString: String; SubStrings : String; Chr: Char) : Boolean;
{stellt fest, ob OrgString in Teilstring in der Stringmenge SubStrings ist. SubStrings ist ein String, der aus mehreren - mit Chr getrennten Strings besteht}
var xString : String;
AktPos : Integer;
WorkStr : String;
begin
Result := False;
WorkStr := SubStrings;
AktPos := Pos(Chr, WorkStr);
while AktPos > 1 do
begin
xString := Trim(Copy(WorkStr, 0, AktPos - 1));
Delete(WorkStr, 1, AktPos + 1);
if OrgString = xString then
begin
Result := True;
exit;
end;
AktPos := Pos(Chr, WorkStr);
end; {WHILE}
if OrgString = WorkStr then Result := True;
end;

Alle Zeichen eines Strings ab einer Position wiedergeben

procedure CutString(var Source, Dest: String; const Position: Byte); //schneidet die Zeichen ab Position ab und gibt sie als Dest zurück
var x : Byte;
begin
for x := Position to Length(Source) - 1 do
begin
Dest := Dest + Source[Position];
Source[x] := Chr(0);
end;
end;

Alle Leerzeichen und Tabs am Ende des Stringes entfernen

function TrimRight(Strng: String): String; // entfernt Leerzeichen und Tabs am Ende von Strng
var x : Word;
begin
Result := Strng;
for x := Length(Result) downto 0 do
begin
if Length(Result) = 0 then exit;
if (Result[x] <> ' ') or (Ord(Result[x]) <> 8) then exit;
Result[x] := Chr(0);
end;
end;

Zahlenroutinen

Testen, ob String ein Integer ist

function IsInt(const Strng: String) : Boolean; {überprüft ob Strng ein Integerwert ist}
var x : Integer;
begin
Result := False;
if Length(Trim(Strng)) = 0 then exit;
for x := 1 to Length(Trim(Strng)) do
case Ord(Trim(Strng)[x]) of
48 .. 57: Result := True; // 0 bis 9; keine Anweisung
43, 45: if x = 1 then Result := True; // Vorzeichen + bzw. - nur an erster Stelle
end; // CASE-Block
end;

Prüfen, ob x Teiler von y ist

function DivisorOf(const AskInt, Teiler: Integer) : Boolean; {überprüft ob AskInt ganzzahlig durch Teiler zu dividieren ist}
begin
if Teiler Mod AskInt = 0 then Result := True
else Result := False
end;

Einen Hex-String in Integer umwandeln

function HexStrToInt(HexStr: String): LongInt; // Hexadezimale Strings werden in Integer verwandelt
var x : Byte; // FOR-Schleife
y : Byte; // Exponenten-Zähler (da letzte Ziffer = 16^0, davor 16^1 ..)
begin
Result := 0;
y := 0;
for x := Length(HexStr) downto 1 do
begin
case StrToIntDef(HexStr[x], 99) of
0..9: Result := Result + Trunc(SqrX(16, y)) * StrToInt(HexStr[x]);
end;
case HexStr[x] of
'A', 'a' : Result := Result + Trunc(SqrX(16, y)) * 10;
'B', 'b' : Result := Result + Trunc(SqrX(16, y)) * 11;
'C', 'c' : Result := Result + Trunc(SqrX(16, y)) * 12;
'D', 'd' : Result := Result + Trunc(SqrX(16, y)) * 13;
'E', 'e' : Result := Result + Trunc(SqrX(16, y)) * 14;
'F', 'f' : Result := Result + Trunc(SqrX(16, y)) * 15;
'0'..'9' : // Dummy-Anweisung, damit 0..9 nicht als unzulässige Zeichen zählen
else
begin // HexStr enthält unzulässiges Zeichen (A..F, 0..9)
Result := -1;
exit;
end; // else
end; // case
Inc(y);
end; // for
end; // Prozedur

Das x-te Quadrat von y ermitteln

function SqrX(Basis: Real, Exponent: Integer): Real; // Ermittelt das X-te Quadrat der Basis
var x : Byte;
begin
Result := Basis;
case Exponent of
0 : Result := 1;
1 : Result := Basis
else
for x := 2 to Exponent do Result := Result * Basis;
end; // CASE
end;

Schnell ermitteln, ob a < b < c

function MinXMax(MinVal, xVal, MaxVal : Double) : Boolean; // ermittelt ob xVal zwischen (einschließlich) MinVal und MaxVal liegt (MinVal <= xVal <= MaxVal)
begin
if (MinVal <= xVal) and (xVal <= MaxVal) then Result := True
else Result := False;
end;

function MinMax(MinVal, xVal, MaxVal : Double) : Boolean; // ermittelt ob xVal zwischen MinVal und MaxVal liegt (MinVal < xVal < MaxVal)
begin
if (MinVal < xVal) and (xVal < MaxVal) then Result := True
else Result := False;
end;

Boolean in Integer umwandeln (und zurück)

function BoolToInt(Bool: Boolean): Byte; //gibt 1 zurück wenn True, bei False 0
begin
if Bool = True then Result := 1
else Result := 0;
end;

function IntToBool(Int : Integer): Boolean; // gibt True zurück, wenn Int > 0
begin
if Int > 0 then Result := True
else Result := False;
end;

Integer in String mit führenden Nullen umwandeln

function ZIntToStr(Int, Stellen : Integer): String;
var S : String;
begin
if Int > Stellen * 10 then begin Result := IntToStr(Int); exit; end;
S := IntToStr(Int);
while Length(S) < Stellen do S := '0' + S;
Result := S;
end;

Dateiroutinen

Test, ob ein Dateiname zulässig ist

function IsFileName(const FileName: string): Boolean;
var x : Integer; {für FOR-Schleife}
const Falsch : String = '/\:*?"<>'; { diese Zeichen dürfen in Dateinamen nicht enthalten sein}
begin
if Length(FileName) > 255 then begin Result := False; exit; end;
Result := True; {Standardmäßig True}
for x := 0 to 7 do
begin
if Pos(Falsch[x], ExtractFileName(FileName)) > 0 then
begin
Result := False;
exit;
end;
end;
end;

Test, ob ein Verzeichnisname zulässig ist

function IsDirName(const Directory: string): Boolean; // ermittelt ob Directory ein zulässiger Verzeichnisname ist
var x : ShortInt; {für FOR-Schleife}
const Falsch : String = '/*?"<>'; {Zeichen dürfen in Verzeichnisnamen nicht enthalten sein}
begin
Result := True; {Standardmäßig True}
for x := 0 to 5 do
begin
if Pos(Falsch[x], ExtractFileName(Directory)) > 0 then
begin
Result := False;
exit;
end;
end;
end;

Dateinamen ohne Endung ermitteln

function ExtractFileNameNoExt(const FileName: String) : String; // extraiert den reinen Dateinamen ohne Pfad oder Erweiterung
var Ext : String;
x : Integer;
begin
Result := ExtractFileName(FileName);
Ext := ExtractFileExt(Result);
if Ext = '' then exit;
repeat
x := Pos('.', Result)
until x <> 0;
Delete(Result, x, Length(Result));
end;

Aus einer file://-URL den Dateinamen extrahieren

function URLToFileName(const URL : string): String; // ermittelt den Dateinamen aus einer URL (muß auf Datei verweisen)
begin
Result := URL;
If Pos('file:///', Result) = 0 then exit;
Delete(Result, 0, 8); // Löscht File:///
Result := Replace(Result, '/', '\');
Result := ExtractFileName(Result);
end;

Mehrere Dateien kopieren oder löschen (Platzhalter erlaubt)

function ZCopyFile(FileName: String; Destination: String; Overwrite: Boolean): Boolean; // kopiert die in FileName angegebene Datei nach Destination
var von, nach : String;
Pvon, Pnach : ^PChar;
ToName: String;
SearchRec: TSearchRec;
begin
Result := False;
if FindFirst(FileName, faAnyFile, SearchRec) <> 0 then begin SysUtils.FindClose(SearchRec); exit; end;
von := ExtractFilePath(FileName) + SearchRec.Name;
ToName := ExtractFileName(Destination);
if ToName = '' then ToName := SearchRec.Name;
nach := ExtractFilePath(Destination) + ToName;
Pvon := @von;
Pnach := @nach;
if CopyFile(Pvon^, Pnach^, not Overwrite) = True then Result := True;
while FindNext(SearchRec) = 0 do
begin
von := ExtractFilePath(FileName) + SearchRec.Name;
Pvon := @von;
nach := ExtractFilePath(Destination) + SearchRec.Name;
Pnach := @nach;
if CopyFile(Pvon^, Pnach^, not Overwrite) = True then Result := True;
end;
SysUtils.FindClose(SearchRec);
end;

function ZDeleteFile(FileName: String): Boolean; // löscht die in FileName angegebene Datei (Platzhalter erlaubt)
var SearchRec: TSearchRec;
PAktDir : PChar;
begin
Result := True;
GetMem(PAktDir, 512);
GetCurrentDirectory(512, PAktDir); // speichert aktuellen Pfad
ChDir(ExtractFilePath(FileName));
if FindFirst(FileName, faAnyFile, SearchRec) <> 0 then begin SysUtils.FindClose(SearchRec); exit; end;
if not (SearchRec.Name[1] = '.') then
if DeleteFile(PChar(SearchRec.Name)) = False then Result := False;
while FindNext(SearchRec) = 0 do
if not (SearchRec.Name[1] = '.') then
if DeleteFile(PChar(SearchRec.Name)) = False then Result := False;
SysUtils.FindClose(SearchRec);
ChDir(StrPas(PAktDir)); // stellt den Pfad wieder her
FreeMem(PAktDir, SizeOf(PAktDir^));
end;

function ZDeleteFile(FileList: TStringList): Boolean; overload; // löscht die in FileList angegebenen Dateien (Platzhalter erlaubt)
var x : Integer;
Bool : Boolean;
begin
Result := True;
for x := 0 to FileList.Count - 1 do
begin
Bool := ZDeleteFile(FileList[x]);
if Bool = False then Result := False;
end;
end;

Windowsroutinen

Windowsversion ermitteln

type  TWinVer = (wvWin32, wvWin95, wvWin98, wvWinNT);

function Winver: TWinVer;
var vi : TOSVersionInfo;
begin
Result := wvWin32;
vi.dwOSVersionInfoSize := SizeOf(vi);
GetVersionEx(vi);
case vi.dwPlatformId of
VER_PLATFORM_WIN32s : Result := wvWin32;
VER_PLATFORM_WIN32_WINDOWS    : Result := wvWin95;
VER_PLATFORM_WIN32_NT : Result := wvWinNT;
end; //case
if (Result = wvWin95) and (vi.dwMinorVersion = 10) then Result := wvWin98;
end;

Windowsverzeichnis ermitteln

function WinDir: String; {gibt Windowsverzeichnis zurück}
var PWinDir : PChar;
begin
GetMem(PWinDir, 512);
GetWindowsDirectory(PWinDir, 512);
Result := StrPas(PWinDir);
FreeMem(PWinDir, SizeOf(PWinDir^));
end;

Ermitteln, ob eine Anwendung ausgeführt wird

type PRunsAppInfo = ^TRunsAppInfo;
     TRunsAppInfo = record
                        Handle: HWND;
                        Titel: String;
                    end
;

function RunsApp(Titel: String): THandle; // ermittelt, ob eine Aplikation läuft, in deren Windowstitel Titel vorhanden ist
var App : TRunsAppInfo;
begin
App.Titel := Titel;
App.Handle := 0;
EnumWindows(@FndApplication, LongInt(@App));
Result := App.Handle;
end;

function FndApplication(WHandle: HWND; App: LongInt): Boolean; {$IFDEF Win32} stdcall; {$ELSE} ; export; {$ENDIF}
var WinTitel : PChar;
begin
GetMem(WinTitel, 255);
Result := True;
if GetWindowText(WHandle, WinTitel, 255) > 0 then
if Pos(PRunsAppInfo(App).Titel, StrPas(WinTitel)) > 0 then
begin
Result := False;
PRunsAppInfo(App).Handle := WHandle;
end;
FreeMem(WinTitel, SizeOf(WinTitel^));
end;

Namen des aktuellen Windowsusers ermitteln

function WinUser: String;
var Ptr : PChar;
x: DWord;
begin
x := 254;
GetMem(Ptr, 254);
GetUserName(Ptr, x);
Result := StrPas(Ptr);
FreeMem(Ptr, SizeOf(Ptr^));
end;

Windows beenden (auch unter NT)

Hinweis: bei manchen Systemen muß weShutdown übergeben werden, damit sich der Rechner abschaltet (wePoweroff reagiert nicht), was an der Zusammenarbeit zwischen Windows und Platine liegt.

type  TWinExit = (weReboot, weShutdown, wePoweroff, weLogoff, weTerminate);

function ExitWindows(Art: TWinExit): Boolean;
var
hToken : THandle;
tp : TTokenPrivileges;
h : DWord;
begin
result := False;
if WinVer = wvWinNT then
begin
OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES, hToken);
LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tp.Privileges[0].Luid);
tp.PrivilegeCount := 1;
tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
h := 0;
AdjustTokenPrivileges(hToken, False, tp, 0, PTokenPrivileges(nil)^, h);
CloseHandle(hToken);
end;
case Art of
weReboot : Result := ExitWindowsEx(EWX_REBOOT, 0);
weLogoff : Result := ExitWindowsEx(EWX_LOGOFF, 0);
wePoweroff : Result := ExitWindowsEx(EWX_POWEROFF, 0);
weTerminate : Result := ExitWindowsEx(EWX_FORCE, 0);
weShutdown : Result := ExitWindowsEx(EWX_SHUTDOWN, 0);
end; //case
end;

Überprüfen, ob Schriftart installiert

type TKindOfFont = (kfPrinterFont, kfScreenFont, kfBoth, kfNone); {Art der Schrift (Drucker, Bildschirm, beides oder keine bekannte Schrift)}

function FontExists(const Font: String): TKindOfFont; {stellt fest, ob Font eine (zur Zeit) gültige Schriftart ist}
var ScrFont: Boolean;
PrnFont: Boolean;
begin
Result := kfNone;
ScrFont := False;
PrnFont := False;
if Screen.Fonts.IndexOf(Font) > -1 then ScrFont := True;
if Printer.Fonts.IndexOf(Font) > -1 then PrnFont := True;
if ScrFont = True then Result := kfScreenFont;
if PrnFont = True then Result := kfPrinterFont;
if (ScrFont = True) and (PrnFont = True) then Result := kfBoth;
end;

Sonstiges

Eine Pause realisieren

procedure Pause(MilliSek: LongWord); // realisiert eine x MilliSekunden lange Pause
var Start : Longint;
begin
Start := GetTickCount;
repeat
Application.ProcessMessages
until (GetTickCount - Start > MilliSek);
end;

Umrechnung Pixel in Zentimeter und zurück

function PixelToCm(Pixel: Single): Single; // rechnet Pixel in Zentimeter um
begin
result := (Pixel / 2.54) / Screen.PixelsPerInch
end;

function CmToPixel(CM: Single): Single; // rechnet Pixel in Zentimeter um
begin
result := (Screen.PixelsPerInch * CM * 2.54)
end;

Einfache Verschlüsselungsroutine

Hinweis: Diese Verschlüsselungsroutine genügt keinerlei Sicherheitsansprüchen. Sie wurde lediglich entwickelt, um z.B. Paßwörter von nicht kritischen Programmen in INI-Dateien zu speichern. Jeder, der die Decrypt-Routine kennt oder gerne experimentiert, kann das "Paßwort" wieder entschlüsseln, da die Encrypt-Routine lediglich die Buchstaben von einer Zufallszahl abzieht und das Ergebnis und die Zufallszahl nach einem bestimmten Muster zusammengesetzt als Ergebnis zurückliefert.

function Encrypt(const Password: String): String;
var Zufall : Integer;
x,y : Integer;
Pw : String;
Laenge : Byte;
Ergebnis : array[1..30] of Char;
Code : array[1..30] of Char;
MitteLinks : Integer;
MitteRechts : Integer;
begin
Result := '';
Randomize; // Startet Zufallsgenerator
If DivisorOf(Length(Password), 2) = True then Pw := Password + ' ' // ungerade Zeichenzahl nötig
else Pw := Password; // Arbeit mit Pw, da Password Konstanze
Laenge := Length(Pw);
for x := 1 to Laenge do
begin
Zufall := Random(255);
if (Zufall - Ord(Pw[x])) < 27 then Inc(Zufall, 229);
Ergebnis[x] := Chr(Zufall - Ord(Pw[x]));
if Zufall < 256 then Code[x] := Chr(Zufall)
else Code[x] := Chr(Zufall - 229);
end;
MitteLinks := Trunc(Laenge / 2);
MitteRechts := MitteLinks + 1;
for x := 1 to MitteLinks do
begin
y := x * 2;
Result := Result + Code[y] + Ergebnis[MitteRechts]
+ Code[y + 1] + Ergebnis[MitteLinks];
Inc(MitteRechts);
Dec(MitteLinks);
end;
Result := Result + Code[1] + Ergebnis[Laenge];
end;

function Decrypt(const Password: String): String;
var x, y, z : Integer;
Zufall : Integer;
Laenge : Byte;
Ergebnis : array[1..30] of Char;
Code : array[1..30] of Char;
MitteLinks : Integer;
MitteRechts : Integer;
begin
Result := '';
Laenge := Trunc(Length(Password) / 2); // Trunc eigentlich überflüssig, da Länge immer gerade Zahl (bei mittels Encrypt verschlüsselten Passwort)
MitteLinks := Trunc(Laenge / 2);
MitteRechts := MitteLinks + 1;
Code[1] := Password[Length(Password) - 1];
Ergebnis[Laenge] := Password[Length(Password)];
z := 1;
for x := 1 to MitteLinks do
begin
y := x * 2;
Code[y] := Password[z];
Ergebnis[MitteRechts] := Password[z + 1];
Code[y + 1] := Password[z + 2];
Ergebnis[MitteLinks] := Password[z + 3];
Inc(MitteRechts);
Dec(MitteLinks);
Inc(z, 4);
end;
for x := 1 to Laenge do
begin
Zufall := Ord(Code[x]);
z := Zufall - Ord(Ergebnis[x]);
if Z < 27 then Z := Zufall + 229 - Ord(Ergebnis[x]);
Result := Result + Chr(z);
end;
Result := Trim(Result); // da bei Encrypt bei gerader Anzahl von Buchstaben ein Leerzeichen angehangen wurde
end;

Mausklick simulieren

procedure MouseClick(P: TPoint); //simuliert Klick an angegebener Bildschirmposition
begin
Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE, P.x, P.y, 0,0);
Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN, P.x, P.y, 0,0);
Mouse_Event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP, P.x, P.y, 0,0);
end;

Tastendruck simulieren

>Hinweis: Die nachfolgende Funktion ChkShiftNeeded wird für SendKey benötigt.

procedure SendKey(S:String; WaitTime : Word = 2 );
var x: Integer;
sn : TShiftNeeded;
begin
for x:=1 to Length(S) do
begin
keybd_event(VK_Menu, 0, KEYEVENTF_KEYUP, 0); // alle Tasten fliegen hoch
keybd_event(VK_Control, 0, KEYEVENTF_KEYUP, 0);
keybd_event(VK_RWin, 0, KEYEVENTF_KEYUP, 0);
keybd_event(VK_LWin, 0, KEYEVENTF_KEYUP, 0);
keybd_event(VK_Shift, 0, KEYEVENTF_KEYUP, 0);
sn := ChkShiftNeeded(S[x]);
if sn = snShift then keybd_event(VK_Shift, 0, 0, 0);
if sn = snAltGr then
begin // AltGr entspricht Strg+Alt
keybd_event(VK_Control, 0, 0, 0);
keybd_event(VK_Menu, 0, 0, 0);
end;
keybd_event(vkKeyScan(S[x]), 0, 0, 0);// der eigendliche Tastendruck
keybd_event(vkKeyScan(S[x]), 0, KEYEVENTF_KEYUP, 0);
if WaitTime > 0 then Pause(WaitTime);
end;
keybd_event(VK_Menu, 0, KEYEVENTF_KEYUP, 0); // alle Tasten fliegen auch nach letztem Durchlauf hoch
keybd_event(VK_Control, 0, KEYEVENTF_KEYUP, 0);
keybd_event(VK_RWin, 0, KEYEVENTF_KEYUP, 0);
keybd_event(VK_LWin, 0, KEYEVENTF_KEYUP, 0);
keybd_event(VK_Shift, 0, KEYEVENTF_KEYUP, 0);
end;

Wird Strg, Shift oder Alt für eine Taste benötigt?

Hinweis: Funktioniert nur auf deutscher Tastatur fehlerfrei. Bei anderen Ländern bitte anpassen!

type TShiftNeeded = (snShift, snNone, snAltGr);

function ChkShiftNeeded(Key: Char): TShiftNeeded;
begin
Result := snNone;
case Ord(Key) of
32,35, 43..46, 48..57, 60, 94, 97..122, 252,225, 246,223 : Result := snNone;
33,34, 36..42, 47, 58, 59, 61..63, 65..90, 95,96, 248, 196, 214, 220 : Result := snShift;
64, 91..93, 123..126, 128, 178, 179 : Result := snAltGr;
end;
end;

Num-, Caps- oder Scrollock an und ausschalten

procedure SetLED(Key: Byte; MakeOn: Boolean); //ändert Num-, Caps oder Scrollock,
var
KS: TKeyboardState;
OnOrOff: Boolean;
begin
GetKeyboardState(KS);
OnOrOff:= KS[Key] <> 0;
// Wenn Status vom gewünschten abweicht
if (OnOrOff xor MakeOn) then
begin
// Je nach Plattform / Key unterschiedliche Strategien
if (Win32Platform = VER_PLATFORM_WIN32_NT)
or (Key <> VK_NUMLOCK) then
begin
// Tastendruck simulieren
keybd_event(Key, $45, KEYEVENTF_EXTENDEDKEY, 0);
keybd_event(Key, $45, KEYEVENTF_EXTENDEDKEY or
KEYEVENTF_KEYUP, 0);
end
else
begin
// Gewünschten Status per Setkeyboardstate setzen
KS[Key]:= Ord(MakeOn);
SetKeyboardState(KS);
end;
end;
end;

zurück