unit WdxInfo;
interface
uses Inifiles,Windows,SysUtils,Controls,Classes,StrUtils;
const
FT_NOMOREFIELDS = 0;
FT_NUMERIC_32 = 1;
FT_NUMERIC_64 = 2;
FT_NUMERIC_FLOATING = 3;
FT_DATE = 4;
FT_TIME = 5;
FT_BOOLEAN = 6;
FT_MULTIPLECHOICE = 7;
FT_STRING = 8;
FT_FULLTEXT = 9;
ft_datetime = 10;
// for ContentGetValue
FT_NOSUCHFIELD = -1;
FT_FILEERROR = -2;
FT_FIELDEMPTY = -3;
FT_DELAYED = 0;
type AllWdxInfo=record
Name:TstringList;
path:Tstringlist;
end;
OneWdxInfo=record
Field:TstringList;
FieldUnit:TstringList;
end;
tdateformat = record
wYear, wMonth, wDay: word;
end;
pdateformat = ^tdateformat;
ttimeformat = record
wHour, wMinute, wSecond: word;
end;
ptimeformat = ^ttimeformat;
type tContentDefaultParamStruct=record
size,
PluginInterfaceVersionLow,
PluginInterfaceVersionHi:longint;
DefaultIniName:array[0..MAX_PATH-1] of char;
end;
pContentDefaultParamStruct=^tContentDefaultParamStruct;
{Type of the functions needed to get wdx informations}
TContentGetSupportedField = function(FieldIndex: integer; FieldName: pchar; Units: pchar; maxlen: integer): integer; stdcall;
TContentGetValue = function(FileName: pchar; FieldIndex, UnitIndex: integer; FieldValue: pbyte; maxlen, flags: integer): integer; stdcall;
TContentSetDefaultParams=procedure(dps:pContentDefaultParamStruct);stdcall;
Type TWdxInfo=Class
private
AllInfo:AllWdxInfo;
Alone:OneWdxInfo;
IniPos:array[0..MAX_PATH] of char;
dps:tContentDefaultParamStruct;
public
procedure LoadAllInfo(DefIniContPLug,ContPlug:pchar);
procedure GetPluginList(List:TStringList);
function GetPluginPath(PluginName:pchar):pchar;
function GetPluginField(PluginName:pchar):Tstringlist;
function GetUnit(PluginName:pchar;FieldNumber:integer):Tstringlist;
procedure SetIniPos(NewValue:pchar);
function GetFieldNumber(PluginName:pchar;FieldToFind:pchar):integer;
function GetUnitNumber(PluginName:pchar;FieldNumber:integer;UnitToFind:pchar):integer;
function GetNumberOfPlugin:integer;
end;
{Other functions}
procedure Split(const Delimiter: Char;Input: string;const Strings: TStrings);
function WdxFieldType(n: integer): string;
implementation
procedure TWdxInfo.SetIniPos(NewValue:pchar);
begin
FillChar(IniPos,sizeof(IniPos),#0);
strlcat(IniPos,NewValue,sizeof(IniPos)-1);
end;
function TWdxInfo.GetNumberOfPlugin:integer;
begin
result:=AllInfo.Name.Count-1;
end;
procedure TWdxInfo.LoadAllInfo(DefIniContPLug,ContPlug:pchar); //Load plugin name & associate path...
var tmpIni:TIniFile;
i:integer;
s:string;
begin
tmpIni:=TIniFile.create(IniPos);
AllInfo.Name:=TStringList.Create;
AllInfo.path:=TStringList.Create;
Alone.Field:=TStringList.Create;
Alone.FieldUnit:=TStringList.Create;
tmpIni.ReadSection('PluginList',AllInfo.Name);
For i:=0 to AllInfo.Name.Count-1 do begin
s:=tmpIni.ReadString('PluginList',AllInfo.Name[i],'');
AllInfo.path.Add(s);
end;
dps.PluginInterfaceVersionLow:=40;
dps.PluginInterfaceVersionHi:=1;
dps.size:=sizeof(dps);
s:=ContPlug;
FillChar(dps.DefaultIniName,sizeof(dps.DefaultIniName),#0);
strlcat(dps.DefaultIniName,pchar(s),sizeof(dps.DefaultIniName)-1);
dps.size:=sizeof(dps);
// MessageBox(GetActiveWindow,dps.DefaultIniName,'kl',MB_OK);
end;
function WdxFieldType(n: integer): string;
begin
case n of
FT_NUMERIC_32: Result:= '';
FT_NUMERIC_64: Result:= '';
FT_NUMERIC_FLOATING: Result:= '';
FT_DATE: Result:= '';
FT_TIME: Result:= '';
FT_DATETIME: Result:= '';
FT_BOOLEAN: Result:= '';
FT_MULTIPLECHOICE: Result:= '';
FT_STRING: Result:= '';
FT_FULLTEXT: Result:= '';
FT_NOSUCHFIELD: Result:= '';
FT_FILEERROR: Result:= '';
FT_FIELDEMPTY: Result:= '';
FT_DELAYED: Result:= '';
else Result:= '';
end;
end;
procedure TWdxInfo.GetPluginList(List:TStringList);
var i:integer;
begin
List.Clear;
For i:=0 to AllInfo.Name.Count-1 do begin
list.Add(Allinfo.Name[i]);
end;
end;
function TWdxInfo.GetPluginPath(PLuginName:pchar):pchar;
var
i:integer;
FindIt:boolean;
error:string;
begin
result:=pchar('');
FindIt:=false;
For i:=0 to AllInfo.Name.count-1 do begin
if UpperCase(AllInfo.Name[i])=UpperCase(PluginName) then begin
result:=pchar(AllInfo.path[i]);
FindIt:=true;
end;
end;
if not FindIt then begin
error:='Syntax error in the name of the plugin'+sLineBreak+PluginName+' was not find... Verify it please !' + sLineBreak + 'The process will continue but this value will be empty';
MessageBox(GetActiveWindow, pchar(error) ,'Warning',MB_OK or MB_ICONERROR);
result:=pchar('Empty');
end;
end;
function TWdxInfo.GetUnit(PluginName:pchar;FieldNumber:integer):Tstringlist;
var
Hlib:Thandle;
j:integer;
Proc0: TContentGetSupportedField;
proc1:TContentSetDefaultParams;
buf1, buf2: array[0..2*1024] of char;
List:TstringList;
s:string;
begin
hLib:= LoadLibrary(PluginName);
if hLib=0 then begin
List:=tstringlist.create;
List.Add('');
result:=List;
Exit
end else begin
@Proc1:=GetProcAddress(hLib,'ContentSetDefaultParams');
if @Proc1<>nil then begin
Proc1(@dps);
//MessageBox(GetActiveWindow, dps.DefaultIniName ,'Warning',MB_OK or MB_ICONERROR);
end;
@Proc0:= GetProcAddress(hLib, 'ContentGetSupportedField');
if @Proc0=nil then begin
FreeLibrary(hLib);
List:=tstringlist.create;
List.Add('');
result:=List;
Exit;
end;
List:=TStringList.Create;
FillChar(buf1, SizeOf(buf1), 0);
FillChar(buf2, SizeOf(buf2), 0);
Proc0(FieldNumber, buf1, buf2, SizeOf(buf1));
{Home Made Unit Can be removed because I don't really use it in the getWanted Value...
case j of
//1,2,3: //valeur numerique
4:strlcat(buf2,pchar('D|M|Y'),sizeof(buf2)-1);//date
5:strlcat(buf2,pchar('H|M|S'),sizeof(buf2)-1);//temps
6:strlcat(buf2,pchar('True|False'),sizeof(buf2)-1);//boolean
10:strlcat(buf2,pchar('D|M|Y|H|M|S'),sizeof(buf2)-1);//datetime
end;}
if buf2<>'' then begin //to avoid problem with unit containing space...
s:=StringReplace(buf2,' ', '_',[rfReplaceAll, rfIgnoreCase]);
Split('|',s,List);
for j:=0 to List.count-1 do begin
List[j]:=StringReplace(List[j],'_', ' ',[rfReplaceAll, rfIgnoreCase]);
end;
end;
FreeLibrary(hLib);
result:=List;
end;
end;
function TWdxInfo.GetPluginField(PluginName:pchar):Tstringlist;
var
Hlib:Thandle;
j:integer;
Proc1: TContentGetSupportedField;
proc0:TContentSetDefaultParams;
buf1, buf2: array[0..2*1024] of char;
fieldsNum: integer;
List:TstringList;
begin
hLib:= LoadLibrary(PluginName);
if hLib=0 then begin
List:=tstringlist.create;
List.Add('');
result:=List;
Exit;
end else begin
@Proc0:=GetProcAddress(hLib,'ContentSetDefaultParams');
if @Proc0<>nil then Proc0(@dps);
@Proc1:= GetProcAddress(hLib, 'ContentGetSupportedField');
if @Proc1=nil then begin
FreeLibrary(hLib);
List:=tstringlist.create;
List.Add('');
result:=List;
Exit
end;
List:=TStringList.Create;
fieldsNum:= -1;
repeat
FillChar(buf1, SizeOf(buf1), 0);
FillChar(buf2, SizeOf(buf2), 0);
j:= Proc1(fieldsNum+1, buf1, buf2, SizeOf(buf1));
case j of
0:Break;
end;
Inc(fieldsNum);
List.Add(buf1);
until false;
FreeLibrary(hLib);
result:=List;
end;
end;
function TWdxInfo.GetFieldNumber(PluginName:pchar;FieldToFind:pchar):integer;
var Hlib:Thandle;
i,j:integer;
Proc1: TContentGetSupportedField;
proc0:TContentSetDefaultParams;
buf1, buf2: array[0..2*1024] of char;
fieldsNum: integer;
List:TstringList;
begin
hLib:= LoadLibrary(PluginName);
if hLib=0 then begin
result:=0;
Exit;
end else begin
@Proc0:=GetProcAddress(hLib,'ContentSetDefaultParams');
if @Proc0<>nil then begin
Proc0(@dps);
//MessageBox(GetActiveWindow, dps.DefaultIniName ,'Warning',MB_OK or MB_ICONERROR);
end;
@Proc1:= GetProcAddress(hLib, 'ContentGetSupportedField');
if @Proc1=nil then begin FreeLibrary(hLib); result:=0;Exit end;
List:=TStringList.Create;
fieldsNum:= -1;
repeat
FillChar(buf1, SizeOf(buf1), 0);
FillChar(buf2, SizeOf(buf2), 0);
j:= Proc1(fieldsNum+1, buf1, buf2, SizeOf(buf1));
case j of
0:Break;
{//1,2,3: //valeur numerique
4:strlcat(buf2,pchar('D|M|Y'),sizeof(buf2)-1);//date
5:strlcat(buf2,pchar('H|M|S'),sizeof(buf2)-1);//temps
6:strlcat(buf2,pchar('True|False'),sizeof(buf2)-1);//boolean
10:strlcat(buf2,pchar('D|M|Y|H|M|S'),sizeof(buf2)-1);//datetime}
end;
Inc(fieldsNum);
List.Add(buf1);
until false;
FreeLibrary(hLib);
j:=0;
For i:=0 to List.Count-1 do begin
if List[i]=FieldToFind then j:=i;
end;
result:=j;
end;
end;
function TWdxInfo.GetUnitNumber(PluginName:pchar;FieldNumber:integer;UnitToFind:pchar):integer;
var Hlib:Thandle;
i,j:integer;
Proc1: TContentGetSupportedField;
proc0:TContentSetDefaultParams;
buf1, buf2: array[0..2*1024] of char;
List:string;
unList:TstringList;
begin
hLib:= LoadLibrary(PluginName);
if hLib=0 then begin result:=0;Exit;
end else begin
@Proc0:=GetProcAddress(hLib,'ContentSetDefaultParams');
if @Proc0<>nil then begin
Proc0(@dps);
//MessageBox(GetActiveWindow, dps.DefaultIniName ,'Warning',MB_OK or MB_ICONERROR);
end;
@Proc1:= GetProcAddress(hLib, 'ContentGetSupportedField');
if @Proc1=nil then begin FreeLibrary(hLib); result:=0;Exit end;
FillChar(buf1, SizeOf(buf1), 0);
FillChar(buf2, SizeOf(buf2), 0);
j:= Proc1(FieldNumber, buf1, buf2, SizeOf(buf1));
List:=buf2;
FreeLibrary(hLib);
unList:=TStringList.Create;
if List<>'' then begin
split('|',List,unList);
For i:=0 to unList.Count-1 do begin
if unList[i]=UnitToFind then j:=i;
end;
end else j:=0;
unList.Free;
result:=j;
end;
end;
{==============================================================================}
procedure Split(const Delimiter: Char;Input: string;const Strings: TStrings);
begin
Assert(Assigned(Strings));
Strings.Clear;
Strings.Delimiter := Delimiter;
Strings.DelimitedText := Input;
end;
end.
| Detected encoding: ASCII (7 bit) | 2
|