Source file: /~heha/hsn/WdxInfoPacker64.zip/WdxStruc.pas

{$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