{$apptype console}
program DrvConv; uses windows, imagehlp;//, sysutils;
var
   base:integer;

type
PImageImportDescriptor = ^TImageImportDescriptor;
TImageImportDescriptor = packed record
  OriginalFirstThunk: dword;
  TimeDateStamp: dword;
  ForwarderChain: dword;
  Name: dword;
  FirstThunk: dword;
end;

var
    img: PLoadedImage;
    Section: PImageSectionHeader;
    str: string; i: integer;

    ImpTable: PImageImportDescriptor;
    ImpName: pinteger;

begin
    str:= ParamStr(1); if str = '' then exit;
    img:= ImageLoad(pchar(str), nil);
    if img = nil then exit;

    MapAndLoad(pchar(str), nil, img, true, false);

//перебор секций
for i := 0 to img.NumberOfSections-1 do
begin
    Section:= pointer(integer(img.Sections)+SizeOf(TImageSectionHeader)*i);
    str:= pchar(@Section.Name);
    if str = '.idata' then break;
end;
//скорректировать смещение базы
    base :=integer(img.MappedAddress)-
                    (Section.VirtualAddress - Section.PointerToRawData);
//установить указатель на таблицу
    ImpTable := pointer(integer(img.MappedAddress)+Section.PointerToRawData);

//перебор таблицы
    while ImpTable.Name <> 0 do
    begin
      str := pchar(ImpTable.Name+ Base);

       ImpName:= pointer(ImpTable.FirstThunk+base);
   //перебор имен
        while ImpName^ <> 0 do
         begin
          if str = 'kernel32.dll' then
              writeln (str,' ', pchar(ImpName^+2+base));

         Inc(ImpName);
        end;

      Inc(ImpTable);
    end;

    writeln ('done');
end.




{$apptype console}
program xtest;uses  sysutils;

const cr = #$d#$a; ap = #39;
var
    i, ii : integer;

    f:text;
    wordlist : array [0..100000] of string;


function load_str (str:string):integer;
var i:integer;
begin
   Assign (f, str); Reset (f);
   for i:= 0 to 100000 do if EOF(f) then break else readln(f,wordlist[i]);
   Close(f);
//   rndmax := i;
 result := i;
end;


begin

 ii:= load_str('func.txt');


writeln (
'{$warnings off}{$hints off}'+cr+
'library fakedll;'+cr+
'const LibName = '+ap+ 'kernel32.dll'+ap+ ';' +cr+
cr+
cr+
'type TCallFunc = record'+cr+
'    i: integer;'+cr+
'    n: pchar;'+cr+
'end; '+cr+
'PCallFunc = ^TCallFunc;'+cr+
'cf = TCallFunc;'+cr+
cr+
'procedure logcf (f:PCallFunc);'+cr+
'begin'+cr+
'if f.i = 0 then writeln (f.n);'+cr+
'  inc(  f.i); '+cr+
'end;'+cr+cr
);


 for i := 0 to ii-1 do  begin

            writeln ('procedure '+ 'proc',i, ';external LibName name '+ap+wordlist[i] +ap,';');

 end;


writeln;
writeln;
writeln;

 for i := 0 to ii-1 do  begin writeln (
'procedure _proc',i,'; const f:cf=(i:0;n:' +cr +
'          '+ap+wordlist[i] +ap + '); asm lea eax,f call logcf'+cr+
'      jmp  proc',i,cr+
'end;'

);
end;


writeln;
writeln;
writeln (
'exports');

 for i := 0 to ii-1 do writeln (
'_proc',i,' name '+ap+wordlist[i]+ap+','


);

writeln ('end.');

end.