I Give
- Posted by euman at bellsouth.net Feb 27, 2002
- 405 views
Matts cdecl routine seems to work but this program doesnt. I wanted to create a library to read-write cab files using Euphoria and only making calls to cabinet.dll. trace(1) is where I left off because xFDIIsCabinet returns NULL and doesnt set an error either. I give up! Maybe a more enterprising individual can solve this problem. Damn all this converting stuff from C to Euphoria its a pain in the butt. Euman euman at bellsouth.net with trace include asm.e include dll.e include misc.e integer xHeapCreate, xHeapDestroy, xHeapAlloc, xHeapFree, xCreateFile, xOpenFile, xReadFile, xWriteFile, xSetFilePointer, xCloseHandle, xFDICreate, xFDIIsCabinet, xFDICopy, xFDIDestroy procedure not_found(sequence name) puts(1, "Couldn't find " & name & '\n') abort(1) end procedure function link_c_func(atom dll, sequence name, sequence args, atom result) integer handle handle = define_c_func(dll, name, args, result) if handle = -1 then not_found(name) else return handle end if end function function link_c_proc(atom dll, sequence name, sequence args) integer handle handle = define_c_proc(dll, name, args) if handle = -1 then not_found(name) else return handle end if end function procedure link_dll_routines() atom kernel32, cabinet kernel32 = open_dll("kernel32.dll") if kernel32 = NULL then not_found("kernel32.dll") end if cabinet = open_dll("cabinet.dll") if cabinet = NULL then not_found("cabinet.dll") end if xHeapCreate = link_c_func(kernel32,"HeapCreate",{C_LONG,C_LONG,C_LONG},C_LONG) xHeapDestroy = link_c_func(kernel32,"HeapDestroy",{C_LONG},C_LONG) xHeapAlloc = link_c_func(kernel32,"HeapAlloc",{C_LONG,C_LONG,C_LONG},C_LONG) xHeapFree = link_c_func(kernel32,"HeapFree",{C_LONG,C_LONG,C_LONG},C_LONG) xCreateFile = link_c_func(kernel32,"CreateFileA",{C_POINTER,C_LONG,C_LONG,C_POINTER,C_LONG,C_LONG,C_INT},C_LONG) xOpenFile = link_c_func(kernel32,"OpenFile",{C_POINTER,C_POINTER,C_UINT},C_LONG) xReadFile = link_c_func(kernel32,"ReadFile",{C_INT,C_POINTER,C_UINT,C_POINTER,C_POINTER},C_LONG) xWriteFile = link_c_func(kernel32,"WriteFile",{C_INT,C_POINTER,C_LONG,C_POINTER,C_POINTER},C_LONG) xSetFilePointer = link_c_func(kernel32,"SetFilePointer",{C_LONG,C_LONG,C_POINTER,C_LONG},C_LONG) xCloseHandle = link_c_func(kernel32,"CloseHandle",{C_LONG},C_LONG) xFDICreate = link_c_func(cabinet,"FDICreate",{C_POINTER,C_POINTER,C_POINTER,C_POINTER,C_POINTER,C_POINTER,C_POINTER,C_INT,C_LONG},C_LONG) xFDIIsCabinet = link_c_func(cabinet,"FDIIsCabinet",{C_LONG,C_INT,C_POINTER},C_INT) xFDICopy = link_c_func(cabinet,"FDICopy",{C_LONG,C_POINTER,C_POINTER,C_INT,C_POINTER,C_POINTER,C_INT},C_LONG) xFDIDestroy = link_c_proc(cabinet,"FDIDestroy",{C_LONG}) end procedure link_dll_routines() object junk constant HEAP_ZERO_MEMORY=#00000008 global atom pHeap pHeap = c_func(xHeapCreate,{0,16384,0}) global function myalloc(atom size) return c_func(xHeapAlloc,{pHeap,HEAP_ZERO_MEMORY,size}) end function global function myfree(atom pmem) return c_func(xHeapFree,{pHeap,0,pmem}) end function global procedure mypoke(atom mem, object s) poke(mem, s) end procedure global procedure mypoke4(atom mem, object s) poke4(mem, s) end procedure global function mypeek(object si) if integer(si) then return peek(si) else return peek({si[1],si[2]}) end if end function global function mypeek4s(object si) if integer(si) then return peek4s(si) else return peek4s({si[1],si[2]}) end if end function global function mypeek4u(object si) if integer(si) then return peek4u(si) else return peek4u({si[1],si[2]}) end if end function global function allocate_string2(sequence s) atom mem mem = myalloc(length(s)+1) mypoke(mem, s) return mem end function atom alloc_args global function cdecl_myalloc() --atom size) sequence args args = peek4u( {alloc_args , 1}) return c_func(xHeapAlloc,{pHeap,HEAP_ZERO_MEMORY,args[1]}) end function atom free_args global function cdecl_myfree() --atom pmem) sequence args args = peek4u( {free_args , 1}) return c_func(xHeapFree,{pHeap,0,args[1]}) end function constant -- Matt Lewis Routine func_asm = { #55, -- 0: push ebp #89,#E5, -- 1: mov ebp, esp #51, -- 3: push ecx #B9,#00,#00,#00,#00, -- 4: mov ecx, argnum (5) #89,#E6, -- 9: mov esi, esp #83,#C6,#0C, -- B: add esi, 12 #BF,#00,#00,#00,#00, -- E: mov edi, myargs (15) #F3,#A5, -- 13: rep movsd; next we call the proc #FF,#15,#00,#00,#00,#00,-- 15: call dword ptr [pfunc] (#17) #59, -- 1B: pop ecx #89,#EC, -- 1C: mov esp, ebp #5D, -- 1E: pop ebp #C2,#00,#00,#00,#00} -- 1F: ret [argnum] (#20) constant offset = length( func_asm ) global function new_pfunc_cdecl( atom callback, integer args ) atom func_addr, func_retval, func_pfunc, func_args func_addr = allocate( length(func_asm) + 4 * 12 ) poke( func_addr, func_asm ) func_retval = func_addr + offset func_pfunc = func_retval + 4 func_args = func_pfunc + 4 poke4( func_addr + #05, args ) poke4( func_addr + #0F, func_args ) poke4( func_addr + #17, func_pfunc ) poke4( func_pfunc, callback ) return { func_addr, func_args } end function global constant GENERIC_READ = #80000000, GENERIC_WRITE = #40000000, FILE_ATTRIBUTE_NORMAL = #80, FILE_BEGIN = 0, FILE_CURRENT = 1, FILE_END = 2, FILE_FLAG_WRITE_THROUGH = #80000000, FILE_FLAG_OVERLAPPED = #40000000, FILE_FLAG_NO_BUFFERING = #20000000, FILE_FLAG_RANDOM_ACCESS = #10000000, FILE_FLAG_SEQUENTIAL_SCAN = #8000000, FILE_FLAG_DELETE_ON_CLOSE = #4000000, FILE_FLAG_BACKUP_SEMANTICS = #2000000, FILE_FLAG_POSIX_SEMANTICS = #1000000, CREATE_NEW = 1, CREATE_ALWAYS = 2, OPEN_EXISTING = 3, OPEN_ALWAYS = 4, TRUNCATE_EXISTING = 5, INVALID_HANDLE_VALUE = -1 global function CreateFile(sequence fname,sequence accmode) atom File, FileName FileName = allocate_string2(fname) if compare(accmode,"rb")=0 then File = c_func(xCreateFile,{FileName,GENERIC_READ,1,NULL,OPEN_EXISTING,FILE_ATTRIBUTE_NORMAL+ FILE_FLAG_SEQUENTIAL_SCAN,NULL}) elsif compare(accmode,"wb")=0 then File = c_func(xCreateFile,{FileName,GENERIC_WRITE,0,NULL,CREATE_ALWAYS,FILE_ATTRIBUTE_NORMAL+ FILE_FLAG_SEQUENTIAL_SCAN,NULL}) end if junk = myfree(FileName) return File end function --typedef struct _OFSTRUCT { --constant -- cBytes = 0, -- fFixedDisk = 1, -- nErrCode = 5, -- Reserved1 = 9, -- Reserved2 = 13, -- szPathName = 14, --128 bytes long -- Sizeof_OFSTRUCT = 142 --atom ReOpenBuff --ReOpenBuff = myalloc(142) --global function OpenFile(sequence FileName) --atom lpFileName --lpFileName = allocate_string2(FileName) --return c_func(xOpenFile,{lpFileName, ReOpenBuff, GENERIC_READ}) --end function --WriteFile() --hFile (handle) obtained by CreateFile --must have GENERIC_WRITE access atom writebytes writebytes = myalloc(4) atom wfile_args function WriteFile() --atom hFile, atom lpBuffer, atom nNumberOfBytesToWrite) atom File sequence args args = peek4u( {wfile_args , 3}) junk = c_func(xWriteFile,{args[1],args[2],args[3],writebytes,0}) return 1 end function --ReadFile() --hFile (handle) obtained by CreateFile --must have GENERIC_READ access atom readbytes readbytes = myalloc(4) --lpNumberOfBytesRead atom rfile_args function ReadFile() --atom hFile, atom lpBuffer, atom nNumberOfBytesToRead) atom File sequence args args = peek4u( {rfile_args, 3}) return c_func(xReadFile,{args[1],args[2],args[3],readbytes,0}) --hFile,lpBuffer,nNumberOfBytesToRead,readbytes,0}) --junk = mypeek({args[2],args[3]}) --return 1 end function function CloseFile(atom handle) if handle != 0 then return c_func(xCloseHandle,{handle}) end if end function constant SEEK_SET = 0, --/* seek to an absolute position */ SEEK_CUR = 1, --/* seek relative to current position */ SEEK_END = 2 atom seek_args function SetFilePos() --atom hf, atom dist, atom seektype) integer dMethod sequence args args = peek4u( {seek_args , 3}) if args[3] = SEEK_SET then dMethod = FILE_BEGIN elsif args[3] = SEEK_CUR then dMethod = FILE_CURRENT elsif args[3] = SEEK_END then dMethod = FILE_END end if return c_func(xSetFilePointer,{args[1], args[2], NULL, dMethod}) end function constant cpuUNKNOWN = -1, cpu80286 = 0, cpu80386 = 1 --typedef struct { constant erfOper = 0, erfType = 4, fError = 8 atom ERF ERF = myalloc(12) object cbPFNALLOC,cbPFNFREE,cbPFNOPEN,cbPFNREAD,cbPFNWRITE,cbPFNCLOSE,cbPFNSEEK, PFNALLOC,PFNFREE,PFNOPEN,PFNREAD,PFNWRITE,PFNCLOSE,PFNSEEK cbPFNALLOC = new_pfunc_cdecl(call_back(routine_id("cdecl_myalloc")),1) PFNALLOC = cbPFNALLOC[1] alloc_args = cbPFNALLOC[2] cbPFNFREE = new_pfunc_cdecl(call_back(routine_id("cdecl_myfree")),1) PFNFREE = cbPFNFREE[1] free_args = cbPFNFREE[2] cbPFNOPEN = new_pfunc_cdecl(call_back(routine_id("CreateFile")),3) PFNOPEN = cbPFNOPEN[1] cbPFNREAD = new_pfunc_cdecl(call_back(routine_id("ReadFile")),3) PFNREAD = cbPFNREAD[1] rfile_args = cbPFNREAD[2] cbPFNWRITE = new_pfunc_cdecl(call_back(routine_id("WriteFile")),3) PFNWRITE = cbPFNWRITE[1] wfile_args = cbPFNWRITE[2] cbPFNCLOSE = new_pfunc_cdecl(call_back(routine_id("CloseFile")),1) PFNCLOSE = cbPFNCLOSE[1] cbPFNSEEK = new_pfunc_cdecl(call_back(routine_id("SetFilePos")),3) PFNSEEK = cbPFNSEEK[1] seek_args = cbPFNSEEK[2] atom hfdi hfdi = c_func(xFDICreate,{PFNALLOC, PFNFREE, PFNOPEN, PFNREAD, PFNWRITE, PFNCLOSE, PFNSEEK, cpu80386, --cpuUNKNOWN, ERF}) -- FDICABINETINFO - Information about a cabinet constant cbCabinet = 0, --// Total length of cabinet file cFolders = 4, --// Count of folders in cabinet cFiles = 6, --// Count of files in cabinet setID = 8, --// Cabinet set ID iCabinet = 10, --// Cabinet number in set (0 based) fReserve = 12, --// TRUE => RESERVE present in cabinet hasprev = 16, --// TRUE => Cabinet is chained prev hasnext = 20 --// TRUE => Cabinet is chained next atom pfdici pfdici = myalloc(24) atom hf hf = OpenFile("sdkinst.cab")--CreateFile("sdkinst.cab","rb") --open this cab file if hf <= 0 then c_proc(xFDIDestroy,{hfdi}) junk = CloseFile(hf) abort(0) end if trace(1) junk = c_func(xFDIIsCabinet,{hfdi, hf, pfdici}) if junk = 0 then c_proc(xFDIDestroy,{hfdi}) junk = CloseFile(hf) end if junk = myfree(ERF) Euman euman at bellsouth.net Q: Are we monetarily insane? A: YES