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).
|
znarf.pas | 22 KB |
|
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
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;
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;
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;
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;
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;