{$D-,O+,Q-,R-,S-}
unit WdxStruc;
interface
uses Windows,SysUtils,someStuff,
{dialogs,}
Classes;
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
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 A=record
s:string;
end;
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;
TContentPluginUnloading=procedure ; stdcall;
Type TWdxInfo=Class
private
Lib:thandle;
proc0:TContentSetDefaultParams;
proc1:TContentGetSupportedField;
proc2:TContentGetValue;
numberOfField:integer;
function FindUnit(unit_name:pchar;fieldNb:integer):integer;
function FindField(fieldname:pchar):integer;
public
isInit:boolean;
CanBeUsed:boolean;
Name:string;
Path:string;
PluginFieldUnit:array[0..256] of tstringlist;
PluginFieldList:tstringlist;
function Load(Plugname,PluginPath:pchar;dps:tContentDefaultParamStruct):boolean;
procedure init();
function Get(filename,fieldname,unit_name:pchar;isDir:boolean):string;
// procedure PrintInfo();
procedure FreeMe(TrueUnload:boolean);
function GetPluginField(PluginName:pchar):Tstringlist;
function GetCurrentUnit(FieldNumber:integer):Tstringlist;
end;
implementation
function Twdxinfo.Load(PlugName,PluginPath:pchar;dps:tContentDefaultParamStruct):boolean;
var val:boolean;
begin
Lib:= LoadLibrary(PluginPath);
Name:=Plugname;
path:=PluginPath;
isInit:=false;
if Lib=0 then begin
val:=false;
end
else begin
val:=true;
Proc0:=TContentSetDefaultParams(GetProcAddress(Lib,'ContentSetDefaultParams'));
if @Proc0<>nil then Proc0(@dps);
end;
result:=val;
end;
procedure TWdxInfo.init();
var
buf1,buf2:array[0..1024] of char;
fieldsNum,j,k:integer;
s:string;
begin
numberOfField:=-1;
buf1[0]:=#0;
buf2[0]:=#0;
Proc1:= TContentGetSupportedField(GetProcAddress(Lib, 'ContentGetSupportedField'));
if @Proc1=nil then begin FreeLibrary(Lib);
PluginFieldList:=tstringlist.create;
PluginFieldList.Add('');
isInit:=false;
end
else begin
PluginFieldList:=TStringList.Create;
fieldsNum:= -1;
repeat
FillChar(buf1, SizeOf(buf1), 0);
FillChar(buf2, SizeOf(buf2), 0);
j:= Proc1(fieldsNum+1, buf1, buf2, SizeOf(buf1));
if (j=0) then Break
else begin
numberOfField:=numberOfField+1;
PluginFieldUnit[numberOfField]:=TStringList.create;
if (j=ft_multiplechoice) then FillChar(buf2,sizeof(buf2),#0);
if buf2<>'' then begin //to avoid problem with unit containing space...
s:=StringReplace(buf2,' ', '_',[rfReplaceAll, rfIgnoreCase]);
Split('|',s,PluginFieldUnit[numberOfField]);
for k:=0 to PluginFieldUnit[numberOfField].count-1 do begin
PluginFieldUnit[numberOfField][k]:=StringReplace(PluginFieldUnit[numberOfField][k],'_', ' ',[rfReplaceAll, rfIgnoreCase]);
end;
end;
end;
Inc(fieldsNum);
PluginFieldList.Add(buf1);
until false;
isInit:=true;
end;
end;
function TWdxInfo.Get(filename,fieldname,unit_name:pchar;isDir:boolean):string;
var i,j,k:integer;
buf1:array[0..1023] of char;
buf2:array[0..1023] of char;
fnval: integer absolute buf1;
fnval64:Int64 absolute buf1;
ffval: Double absolute buf1;
fdate: TDateFormat absolute buf1;
ftime: TTimeFormat absolute buf1;
xtime: TFileTime absolute buf1;
xtime2:tfiletime;
stime: TSystemTime;
sval: string;
begin
sval:=' ';
FillChar(buf1,sizeof(buf1),#0);
FillChar(buf2,sizeof(buf2),#0);
i:=FindField(fieldname);
if ((unitName='') or (unitName='0')) then j:=0
else j:=FindUnit(unit_name,i);
Proc2:= TContentGetValue(GetProcAddress(Lib, 'ContentGetValue'));
if @Proc2<>nil then begin
if (isDir=true) then begin
FillChar(buf2,sizeof(buf2),#0);
StrLCat(buf2,filename,strlen(filename)-1);
k:=Proc2(buf2,i,j,@buf1, sizeof(buf1)-1,0);
end else k:=Proc2(filename,i,j,@buf1, sizeof(buf1)-1,0);
case k of
ft_fieldempty: sval:= '';
ft_numeric_32: sval:= IntToStr(fnval);
ft_numeric_64: sval:= IntToStr(fnval64);
ft_numeric_floating: sval:= FloatToStr(ffval);
ft_date: sval:= Format('%2.2d'+DateSeparator+'%2.2d'+DateSeparator+'%4.4d', [fdate.wDay, fdate.wMonth, fdate.wYear]);
ft_time: sval:= Format('%2.2d'+TimeSeparator+'%2.2d'+TimeSeparator+'%2.2d', [ftime.wHour, ftime.wMinute, ftime.wSecond]);
ft_datetime: begin
FileTimeToLocalFileTime(xtime,xtime2);
FileTimeToSystemTime(xtime2, stime);
sval:= Format('%2.2d'+DateSeparator+'%2.2d'+DateSeparator+'%4.4d %2.2d'+TimeSeparator+'%2.2d'+TimeSeparator+'%2.2d',[stime.wDay, stime.wMonth, stime.wYear,stime.wHour, stime.wMinute, stime.wSecond]);
end;
ft_boolean: if fnval= 0 then sval:= 'FALSE' else sval:= 'TRUE';
ft_string,
ft_multiplechoice,
ft_delayed,
ft_fulltext: sval:= buf1;
else sval:= '';
end;
end;
result:=sval;
end;
function TWdxInfo.FindField(fieldname:pchar):integer;
var i,value:integer;
begin
value:=0;
if (PluginFieldList.count>1) then begin
for i:=0 to PluginFieldList.count-1 do begin
if (UpperCase(PluginFieldList[i])=UpperCase(fieldname)) then value:=i;
end;
end;
result:=value;
end;
function TWdxInfo.FindUnit(unit_name:pchar;fieldNb:integer):integer;
var i,value:integer;
begin
value:=0;
if ( pluginFieldunit[fieldNb].count>1) then begin
for i:=0 to pluginFieldunit[fieldNb].count-1 do begin
if (UpperCase(PluginFieldUnit[fieldNb][i])=UpperCase(unit_name)) then begin
value:=i;
end;
end;
end;
result:=value;
end;
procedure TWdxInfo.FreeMe(TrueUnload:boolean);
var proc3:TContentPluginUnloading;
begin
Proc3:= TContentPluginUnloading(GetProcAddress(Lib, 'ContentPluginUnloading'));
if ((@Proc3<>nil)and (TrueUnload)) then proc3;
FreeLibrary(Lib);
end;
function TWdxInfo.GetPluginField(PluginName:pchar):Tstringlist;
begin
result:=PluginFieldList;
end;
function TWdxInfo.GetCurrentUnit(FieldNumber:integer):Tstringlist;
begin
result:=PluginFieldUnit[FieldNumber];
end;
end.
Detected encoding: ASCII (7 bit) | 2
|