1. I Give
- Posted by euman at bellsouth.net
Feb 27, 2002
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
