Code:
'cgiwrite.bas demonstrates open/get/put/lock/unlock/flush/close functions on the internet
'comments/suggestion link: [URL="http://www.powerbasic.com/support/pbforums/showthread.php?t=29447"]http://www.powerbasic.com/support/pb...ad.php?t=29447[/URL]
declare function getmodulefilename lib "kernel32.dll" alias "getmodulefilenamea" (byval hmodule as dword, lpfilename as asciiz, byval nsize as dword) as dword
declare function getmodulehandle lib "kernel32.dll" alias "getmodulehandlea" (lpmodulename as asciiz) as dword
declare function openfile(filname as string)as long 'rename if using win32api.inc
declare function lockfile(filehandle as long) as long
declare function unlockfile(filehandle as long) as long
declare function getrecord(recordnumber as long, buffer as string,filehandle as long) as long
declare function putrecord(recordnumber as long,buffer as string,filehandle as long) as long
declare function closefile(filehandle as long) as long
declare function flushfile(filehandle as long) as long
declare function killfile(filenam as string) as long
declare function exename as string
declare sub display(text as string)
function pbmain as long
dim filname$,buffer$,hits&,recnum&, l$,programname$,programdir$,org&
dim recordstowrite&,attempt&,filehandle&,result&,recordnumber&, recordlen&
recordstowrite = 10
recordlen = 1000
buffer = space$(recordlen)
stdout "content-type: text/html" & $crlf 'required by some servers
stdout "<pre>"
display "remote_addr " & environ$("remote_addr") & " " & "remote_host " & environ$("remote_host") _
& " " & date$ & " " & time$
programname$ = exename
for org = len(programname$) to 1 step -1
if mid$(programname$, org, 1) = "" then
programdir = left$(programname$, org)
exit for
end if
next
filname = curdir$ + "\hits.txt"
'result = killfile(filname)
stdout "curdir$ " & curdir$
stdout "path_translated " & environ$("path_translated")
filehandle = openfile(filname):if filehandle < 1 then exit function
display "open " & filname & " for binary lock shared as #" & format$(filehandle) & " " & time$
stdout "writing"& str$(recordstowrite) & " records (" & format$(recordlen) & "-bytes each.) start byte of each record:"
result = lockfile(filehandle) 'first lock the file
for recnum = 1 to recordstowrite
lset buffer = format$(lof(1)+1) 'data to write
recordnumber = lof(#filehandle) + 1 'insert at end of file
result = putrecord(recordnumber, buffer,filehandle)
stdout format$(recordnumber) & " ";
next
display "last byte" & str$(lof(filehandle))
stdout "unlock" :result = unlockfile(filehandle)
stdout "flush" :result = flushfile(filehandle)
stdout "close" :result = closefile(filehandle)
stdout "</pre>"
'beep:waitkey$
end function
function lockfile(filehandle as long) as long
dim attempt&,maxattempts&
maxattempts = 10
attempt = 0 'lock record/get/update/flush/unlock
do
errclear
lock #filehandle
if err then
incr attempt
sleep 100
end if
loop until err = 0 or attempt => maxattempts
if attempt => maxattempts then function = errclear
end function
function unlockfile(filehandle as long) as long
dim attempt&,maxattempts&
maxattempts = 10
attempt = 0 'lock record/get/update/flush/unlock
do
errclear
unlock #filehandle
if err then
incr attempt
sleep 100
end if
loop until err = 0 or attempt => maxattempts
if attempt then
if attempt => maxattempts then
function = errclear
end if
end if
end function
function getrecord(recordnumber as long, buffer as string,filehandle as long) as long
get #filehandle,recordnumber,buffer
if err then function = errclear
end function
function putrecord(recordnumber as long, buffer as string,filehandle as long) as long
put #filehandle,recordnumber,buffer
if err then function = errclear
end function
function flushfile(filehandle as long) as long
flush #filehandle
if err then function = errclear
end function
function closefile(filehandle as long) as long
close #filehandle
if err then function = errclear
end function
function openfile(filname as string)as long
dim attempt as long
dim maxattempts as long
dim filehandle as long
maxattempts& = 10
attempt = 0
filehandle = freefile 'was in loop 5/15/17
do
errclear
open filname for binary lock shared as #filehandle
if err then
incr attempt
sleep 100
end if
loop until err = 0 or attempt => maxattempts
if attempt => maxattempts then
function = -errclear
exit function
end if
function = filehandle
end function
function killfile(filname as string) as long
kill filname
if err then function = errclear
end function
sub display(text as string)
stdout text & "<br>" '<br> single <p> double
end sub
function exename() as string
local hmodule as long
local temp as asciiz * 256
hmodule = getmodulehandle(byval 0&)
getmodulefilename hmodule, temp, 256
function = temp
end function
[this message has been edited by mike doty (edited september 01, 2004).]
Comment