Diese DLL ist in Borland Delphi geschrieben wird von KALHelp verwendet.
|
| Deklaration in TurboPL |
..#DLLPROCS
dllproc URegGetValue(sRootKey : String As LPWStr; sKey : String As LPWStr; sValue : String As LPWStr; Var sResult : String As LPWStr; maxlen : Integer) library "khputil7.dll";
dllproc URegSetValue(sRootKey : String As LPWStr; sKey : String As LPWStr; sVar : String As LPWStr; sValue : String As LPWStr): Integer library "khputil7.dll";
dllproc UIniGetValue(sIni : String As LPWStr; sSection : String As LPWStr; sVar : String As LPWStr; sDef : String As LPWStr; Var sResult : String As LPWStr; maxlen : integer) library "khputil7.dll";
dllproc UIniSetValue(sIni : String As LPWStr; sSection : String As LPWStr; sVar : String As LPWStr; sValue : String As LPWStr): Integer library "khputil7.dll";
dllproc UGetAssociatedProgram(sFile: string As LPWStr; VAR sResult: string As LPWStr; maxlen: integer) library "khputil7.dll";
dllproc UOpenAssociatedFile(sFile: string As LPWStr) library "khputil7.dll";
dllproc USetFileAttrib(sFile: string As LPWStr; nAttrib : Integer): Integer library "khputil7.dll";
dllproc USetFileAttribNoReadOnly(sFile: string As LPWStr): Integer library "khputil7.dll";
dllproc USetFileAttribNoHidden(sFile: string As LPWStr): Integer library "khputil7.dll";
dllproc UDirRemoveFull(sDir: string As LPWStr): Integer library "khputil7.dll";
dllproc UDirMakeExtended(sDir: string As LPWStr): Integer library "khputil7.dll";
dllproc UDirCopy(sDir: String As LPWStr; sToDir: String As LPWStr): Integer library "khputil7.dll";
dllproc USortFile(sFilename : String As LPWStr):Integer library "khputil7.dll";
dllproc UStringReplace(sIn : String As LPWStr; sOldPat : String As LPWStr; sNewPat : String As LPWStr; maxlen : Integer; Var sResult : String As LPWStr) library "khputil7.dll";
| | Beispielaufruf in TurboPL |
Procedure XHTMLReplace(sL: string): string;
Vardef sR : String;
?sL = "" / Return ""
sR := "";
If sL[1]="!"
UStringReplace(sL, "!", "", 255, sR);
sL := sR;
End;
UStringReplace(sL, "<<!", "<", 255, sR);
..etc.
Return SL
Endproc;
| | library khputil7; |
library khputil7;
//Historie:
//2005-04-10 - RL - Letze Änderungen
//2001-11-21 - RL - Erste Version
{
für Tests
- die obere Anweisung library Utility auskommentieren
- Anweisung exports am Ende auskommentieren:
- Am Ende zwischen Begin und End. eine ShowMessage Anweisung setzen
ShowMessage(UGetRegValue('HEY_CURRENT_USER','Software | Microsoft|Internet Explorer|Main', 'Search Bar'));
}
uses
Registry,
ShellAPI,
Classes,
IniFiles,
Windows,
SysUtils;
//Dialogs; only for showmessage in case of any checks
{$R *.RES}
//
//LOCAL ROUTINES
//
Function UDirExists(sDir: PWideChar): Boolean;
var i: Integer;
begin
i := GetFileAttributes(PChar(sDir));
Result := (i <> -1) and (FILE_ATTRIBUTE_DIRECTORY and i <> 0)
end;
function DFFileDirOperations(
Action: PWideChar;
RenameIfExists: boolean;
NoConfirmation: boolean;
Silent: boolean;
ShowProgress: boolean;
SourceDirectory: PWideChar;
DestinationDirectory: PWideChar): boolean;
var
SHFileOpStruct: TSHFileOpStruct;
SourceBuffer, DestinationBuffer: array[0..255] of char;
begin
try
if not UDirExists(SourceDirectory) then
begin
Result := False;
exit;
end;
Fillchar(SHFileOpStruct, sizeof(SHFileOpStruct), 0);
FillChar(SourceBuffer, sizeof(SourceBuffer), 0);
FillChar(DestinationBuffer, sizeof(DestinationBuffer), 0);
StrPCopy(SourceBuffer, SourceDirectory);
StrPCopy(DestinationBuffer, DestinationDirectory);
with SHFileOpStruct do
begin
Wnd := 0;
if UpperCase(Action) = 'COPY' then wFunc := FO_COPY;
if UpperCase(Action) = 'DELETE' then wFunc := FO_DELETE;
if UpperCase(Action) = 'MOVE' then wFunc := FO_MOVE;
if UpperCase(Action) = 'RENAME' then wFunc := FO_RENAME;
pFrom := @SourceBuffer;
pTo := @DestinationBuffer;
fFlags := FOF_ALLOWUNDO;
hNameMappings := nil;
lpszProgressTitle := nil;
if RenameIfExists then fFlags := fFlags or FOF_RENAMEONCOLLISION;
if NoConfirmation then fFlags := fFlags or FOF_NOCONFIRMATION;
if Silent then fFlags := fFlags or FOF_SILENT;
if ShowProgress then fFlags := fFlags or FOF_SIMPLEPROGRESS;
fFlags := fFlags or FOF_NOCONFIRMMKDIR;
end;
Result := (SHFileOperation(SHFileOpStruct) = 0);
except
Result := False;
end;
end;
//
//EXPORT
//
//Test on empty string
Function UIsStringEmpty(const pMyParameter: PWideChar): Integer;stdcall;export;
Begin
If StrLen(PChar(pMyParameter)) = 0 then
Result := 1
Else
Result := 0;
End;
//Opens a file or starts a programm (without parameters)
procedure UOpenAssociatedFile(filename : pWideChar); stdcall; export;
var
handle : HWND;
begin
ShellExecute(handle,'open', pChar(filename), nil, nil, SW_NORMAL);
//ShellExecute(Application.Handle,'open',c, nil, nil, SW_NORMAL);
end;
//Get the associated programm to a file
Procedure UGetAssociatedProgram(
pFile : pWideChar;
pResult : PWideChar;
iMaxLen : Integer); stdcall; export;
Var
dok,dir : String;
res : PChar;
res1 : array[1..250] of char;
i, iLen:integer;
sTmp : String;
begin
dok := pChar(pFile) + #0;
dir:=#0;
//dir:=DirectoryListBox1.Directory + #0;
res := StrAlloc(1000);
i := FindExecutable(@dok[1],@dir[1],res);
If i <<= 32 then
sTmp :=''
Else
sTmp := res;
strdispose(res);
iLen := Length(sTmp);
//If sTmp = '' Then sTmp := 'Empty';
StrPLCopy(pChar(pResult), sTmp, iMaxLen);
End;
Function URegGetRootKey(sRootKey : PWideChar) : HKey;
Begin
Result := 0;
sRootKey := pWideChar(UpperCase(sRootKey));
If sRootKey = 'HKEY_CLASSES_ROOT' Then Result := HKEY_CLASSES_ROOT;
If sRootKey = 'HKEY_CURRENT_USER' Then Result := HKEY_CURRENT_USER;
If sRootKey = 'HKEY_LOCAL_MACHINE' Then Result := HKEY_LOCAL_MACHINE;
If sRootKey = 'HKEY_USERS' Then Result :=HKEY_USERS;
If sRootKey = 'HKEY_CURRENT_CONFIG' Then Result :=HKEY_CURRENT_CONFIG;
If sRootKey = 'HKEY_DYN_DATA' Then Result :=HKEY_DYN_DATA;
End;
//Get a value out of the windows registry
Procedure URegGetValue(
pRootKey : pWideChar;
pKey : pWideChar;
pValue : pWideChar;
pResult : PWideChar;
iMaxLen : Integer); stdcall; export;
Var
Registry: TRegistry;
sTmp : String;
iLen : Integer;
Begin
If URegGetRootKey(pRootKey) = 0 Then Exit;
Registry := TRegistry.Create;
try
Registry.RootKey := URegGetRootKey(pRootKey);
Registry.OpenKey(pKey, False);
sTmp := Registry.ReadString(pValue);
iLen := Length(sTmp);
//If sTmp = '' Then sTmp := 'Empty';
StrPLCopy(pChar(pResult), sTmp, iMaxLen);
finally
Registry.CloseKey;
Registry.Free;
End
End;
//sets a value in the registry
Function URegSetValue(
pRootKey : pWideChar;
pKey : pWideChar;
pName : pWideChar;
pValue : PWideChar): Integer; stdcall; export;
Var
Registry: TRegistry;
sTmp : String;
Begin
Result := 0;
If URegGetRootKey(pRootKey) = 0 Then Exit;
Registry := TRegistry.Create;
try
Registry.RootKey := URegGetRootKey(pRootKey);
If Registry.OpenKey(pKey, True) Then
Begin
Registry.WriteString(pName, pValue);
Result := 1;
End
finally
Registry.CloseKey;
Registry.Free;
end
End;
//get an ini string
Procedure UIniGetValue(
pTheIniFile : PWideChar;
pIniSection : PWideChar;
pStringName : PWideChar;
pDefaultString : PWideChar;
pResult : PWideChar;
iMaxLen : Integer); stdcall; export;
Var
TheIni : TIniFile;
sTmp : String;
Begin
//ShowMessage(pTheIniFile + '#' + pIniSection + '#' + pStringName);
TheIni := TIniFile.Create(pTheIniFile);
Try
sTmp := TheIni.ReadString(pIniSection, pStringName, pDefaultString);
If sTmp = '' Then
Begin
sTmp := pDefaultString;
End;
StrPLCopy(pChar(pResult), sTmp, iMaxLen);
Finally
TheIni.Free;
End;
End;
//set an ini string
Function UIniSetValue(
pTheIniFile : PWideChar;
pIniSection : PWideChar;
pStringName : PWideChar;
pStringValue : PWideChar): Integer; stdcall; export;
Var
TheIni : TIniFile;
Begin
TheIni := TIniFile.Create(pTheIniFile);
Try
Try
TheIni.WriteString(pIniSection, pStringName, pStringValue);
Result := 1;
Except
Result := 0;
End;
Finally
TheIni.Free;
End;
End;
//
//FILE ROUTINEN
//
//sets the fileattributes
Function USetFileAttrib(pFilename : PWideChar; nFileAttrib : Integer) : Integer;stdcall;export;
{
faReadOnly $00000001 Schreibgeschützte Dateien
faHidden $00000002 Versteckte Dateien
faSysFile $00000004 Systemdateien
faVolumeID $00000008 Laufwerksbezeichner
faDirectory $00000010 Verzeichnisse
faArchive $00000020 Archivdateien
faAnyFile $0000003F Alle Dateien
}
Var sFilename : String;
Begin
sFilename := String(pFilename);
Result := 0;
if FileExists(sFilename) = True then
begin
If FileSetAttr(sFilename, nFileAttrib) = 0 Then
Result := 1;
End;
End;
//sets the fileattributes to non readonly
Function USetFileAttribNoReadOnly(pFilename : PWideChar) : Integer;stdcall;export;
Var nFileAttrib : Integer;
Var sFilename : String;
Begin
sFilename := String(pFilename);
Result := 0;
nFileAttrib := FileGetAttr(sFilename);
If nFileAttrib And SysUtils.faReadOnly > 0 Then
Begin
nFileAttrib := nFileAttrib - SysUtils.faReadOnly;
If USetFileAttrib(pFilename, nFileAttrib) = 0 Then
Exit;
End;
Result := 1;
End;
Function USetFileAttribNoHidden(pFilename : PWideChar) : Integer;stdcall;export;
Var nFileAttrib : Integer;
Var sFilename : String;
Begin
sFilename := String(pFilename);
Result := 0;
nFileAttrib := FileGetAttr(sFilename);
If nFileAttrib And SysUtils.faHidden > 0 Then
Begin
nFileAttrib := nFileAttrib - SysUtils.faHidden;
If USetFileAttrib(pFilename, nFileAttrib) = 0 Then
Exit;
End;
Result := 1;
End;
//remove a dir incl. files
Function UDirRemoveFull(pDir : PWideChar) : Integer; stdcall; export;
Var
sr: TSearchRec;
sDir: String;
Begin
Result := 0;
sDir := String(pDir);
sDir := IncludeTrailingBackslash(sDir);
If FindFirst(sDir + '*.*', faAnyFile, sr) = 0 then
Begin
If FileExists(sDir + sr.Name) then
Begin
USetFileAttribNoReadOnly(PWideChar(sDir + sr.Name));
DeleteFile(PWideChar(sDir + sr.Name));
End;
End;
While FindNext(sr) = 0 Do
Begin
if FileExists(sDir + sr.Name) then
Begin
USetFileAttribNoReadOnly(PWideChar(sDir + sr.Name));
DeleteFile(PWideChar(sDir + sr.Name));
End;
end;
FindClose(sr);
{$I-}
RmDir(sDir);
{$I+}
if IOResult = 0 then
Result := 1
Else
Result := 0;
End;
Function UDirMakeExtended(pDir : pWideChar): boolean; stdcall; export;
var sDir, sTmpDir : string;
begin
result := False;
sDir := String(pDir);
sDir := IncludeTrailingBackslash(sDir);
sTmpDir := copy(sDir,1,2);
delete(sDir,1,3);
while length(sDir) > 0 do begin
sTmpDir := sTmpDir + '\' + copy(sDir,1,pos('\', sDir)-1);
delete(sDir,1,pos('\',sDir));
{$i-}
mkdir(sTmpDir);
{$i+}
case IOresult of
0,
183 : begin end;
else exit
end;
end;
result := True;
End;
Function UDirCopy(SourceDirectory: PWideChar; DestinationDirectory: PWideChar) : Integer; stdcall; export;
Begin
Result := Integer(DFFileDirOperations('COPY', false, true,false,false,SourceDirectory,DestinationDirectory));
End;
Function USortFile(pFilename : PWideChar) : Boolean; stdcall; export;
Var sFilename : String;
fSL : TStringList;
Begin
Result := False;
sFilename := String(pFilename);
If Not FileExists(sFileName) Then Exit;
fSL := TStringList.Create;
fSL.LoadFromFile(sFilename);
fSL.Sorted := True;
fSL.SaveToFile(sFilename);
fSL.Free;
Result := True;
End;
Procedure UStringReplace(
pIn : PWideChar;
pOldPat : PWideChar;
pNewPat : PWideChar;
iMaxLen : Integer;
pResult : PWideChar); stdcall; export;
Var
sIn, sResult, sOldPat, sNewPat : String;
Begin
sIn := String(pIn);
sOldPat := String(pOldPat);
sNewPat := String(pNewPat);
sResult := StringReplace(sIn, sOldPat, sNewPat, [rfReplaceAll, rfIgnoreCase]);
StrPLCopy(pResult, sResult, iMaxLen);
End;
//
//THE EXPORTS
//
Exports
UIsStringEmpty index 1,
URegGetValue index 2,
URegSetValue index 3,
UIniGetValue index 4,
UIniSetValue index 5,
UGetAssociatedProgram index 6,
UOpenAssociatedFile index 7,
USetFileAttrib index 8,
USetFileAttribNoReadOnly index 9,
USetFileAttribNoHidden index 10,
UDirRemoveFull index 11,
UDirMakeExtended index 12,
UDirCopy index 15;
USortFile index 16,
UStringReplace index 17;
Begin
{--für Tests in delphi}
//UOpenAssociatedFile('test.pdf');
//URegGetValue('HEY_CURRENT_USER','Software\Microsoft\Internet Explorer\Main', 'Search Bar', sP);
//ShowMessage('RegValue = ' + String(sP));
//UIniGetValue('vdp32.ini', 'Tips', 'AktTip', sP);
//ShowMessage('IniValue = ' + String(sP));
End.
| | Hinweise Umstieg VDP 3 |
Folgendes sei zu beachten, wenn VDP 3 DLL's für TurboDB Studio verwendet werden:
In Delphi sind die String Deklarationen in den Parameter einer Funktion oder Procedur durch PWideString zu ersetzen.
Beispiel: Function UDirCopy(SourceDirectory: PWideChar; DestinationDirectory: PWideChar) : Integer; stdcall; export;
In TurboDB Studio in der DLLPROC Deklaration String durch String As LPWStr ersetzen.
Beispiel: dllproc UDirCopy(sDir: String As LPWStr; sToDir: String As LPWStr): Integer library "khputil7.dll";
Ausführlich Information in der TurboDB Studio Hilfedatei unter **Makros und Programme einsetzen, DLL-Funktionen aufrufen**.
|
TurboDB Studio
»
| 