Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Internet functions to read/write binary files

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Mike Doty
    replied
    Code:
    'Confirmation.htm   Input then send data to Confirmation.exe
    'Confirmation.exe decodes and saves to server hard disk
    <HTML>
    <HEAD>
    <META HTTP-EQUIV="Content-Type" CONTENT="text/html; charset=windows-1252">
    <META HTTP-EQUIV="Content-Language" CONTENT="en-us">
    <TITLE>Important Client Information</TITLE>
    </HEAD>
    <BODY>
    <H1>Client Information</H1>
    <FORM METHOD="POST" ACTION="http://www.yourserver.com/cgi-bin/Confirmation.exe">
    
    <TABLE>
    <TR>
    <TD>Name</TD>
    <TD><INPUT TYPE=TEXT NAME="FIELD1_NAME" SIZE=30></TD>
    </TR>
    
    <TR>
    <TD>Street Address</TD>
    <TD><INPUT TYPE=TEXT NAME="FIELD2_ADDRESS1" SIZE=30></TD>
    </TR>
    
    <TR>
    <TD>Address</TD>
    <TD><INPUT TYPE=TEXT NAME="FIELD3_ADDRESS2" SIZE=30></TD>
    </TR>
    
    <TR>
    <TD>City</TD>
    <TD><INPUT TYPE=TEXT NAME="FIELD4_CITY" SIZE=30></TD>
    </TR>
    
    <TR>
    <TD>State</TD>
    <TD><INPUT TYPE=TEXT NAME="FIELD5_STATE" SIZE=30></TD>
    </TR>
    
    <TR>
    <TD>Zip Code</TD>
    <TD><INPUT TYPE=TEXT NAME="FIELD6_ZIP" SIZE=30 MAXLENGTH=30></TD>
    </TR>
    
    <TR>
    <TD>Phone</TD>
    <TD><INPUT TYPE=TEXT NAME="FIELD7_PHONE" SIZE=30 MAXLENGTH=30></TD>
    </TR>
    
    <TR>
    <TD>E-mail</TD>
    <TD><INPUT TYPE=TEXT NAME="FIELD8_EMAIL_IS_USERNAME" SIZE=30></TD>
    </TR>
    
    <TR>
    <TD>Password</TD></TD>
    <TD><INPUT TYPE=PASSWORD NAME="FIELD9_PASSWORD1" SIZE=30 MAXLENGTH=30></TD>
    </TR>
    
    <TR>
    <TD>Confirm Password</TD>
    <TD><INPUT TYPE=PASSWORD NAME="FIELD10_PASSWORD2" SIZE=30 MAXLENGTH=30></TD>
    </TR>
    </TABLE>
    <INPUT TYPE=SUBMIT VALUE="Submit Form">
    <INPUT TYPE=RESET VALUE="Reset Form">
    </FORM>
    </BODY>
    </HTML>

    ------------------

    Leave a comment:


  • Mike Doty
    replied
    Code:
    'Confirmation.exe    CGI program to accept data and save  9/6/04
    'Sample html input form Confirmation.htm
    '
    'This program:
    'Reads, decodes and saves data from browser as a .CSV file to (Confirmation.txt)
    'Sends back to browser data formatted as a table and in a CSV layout for study
    '
    'This program accepts data from the browser using this method:
    '<FORM METHOD="POST" ACTION="http://www.yourserver.com/cgi-bin/Confirmation.exe">
    '
    #DIM ALL
    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 DisplayBold(TEXT AS STRING)
    
    'PBCGI.INC   6 routines needed from PBCGI.INC
    'DECLARE FUNCTION ReadCGI() AS STRING
    'DECLARE SUB WriteCGI(BYVAL x AS STRING)
    'DECLARE FUNCTION ParseParams(BYVAL params AS STRING, Param() AS STRING) AS LONG
    'DECLARE FUNCTION Request_Method() AS STRING
    'DECLARE FUNCTION DecodeCGI(BYVAL t AS STRING) AS STRING
    'DECLARE FUNCTION Content_Length() AS LONG
    $INCLUDE "PBCGI.INC"
    
    FUNCTION PBMAIN AS LONG
      DIM Number_Of_Input_Fields&,x&,temp$,Equal_Sign&
      DIM Comma$, csv$
      Comma$ = ","
    
      'STDOUT "Content-type: text/html" & $CRLF  'required by some servers
      WriteCgi "<pre>" 'handles spaces justified and looks like typewriter output
      REDIM param (0)       AS STRING
      REDIM Decoded(0)      AS STRING
      REDIM Field_Name(0)   AS STRING
      REDIM Data_Entered(0) AS STRING
    
      Number_Of_Input_Fields = ParseParams(ReadCgi,Param$())
      REDIM Decoded$(Number_Of_Input_Fields), Data_Entered$(Number_Of_Input_Fields)
      REDIM Field_Name$(Number_Of_Input_Fields)
      DisplayBold "Actual data returned: Length " & STR$(Content_Length)
      FOR x = 1 TO Number_Of_Input_Fields
        temp$ = DecodeCgi(Param$(x))   'each input field and data entered decoded
        writecgi temp
        Decoded$(x) = Temp                       'save for placing into table later
        Equal_Sign = INSTR(temp$,"=")      'data entered starts after = sign
        Field_Name$(x) = LEFT$(temp, Equal_Sign-1)    'Field name passed by browser
        Data_Entered$(x) = MID$(temp$,Equal_Sign + 1) 'Data typed passed by browser
    
        'CSV string of data entered (just an additional example)
        'might be useful for storing data in a sequential file
        csv$ = csv$ + $DQ & Data_Entered(x) & $DQ & Comma$
      NEXT
      csv$ = LEFT$(csv,LEN(csv) -1) + $CRLF  'suitable for writing to disk
      DisplayBold csv                 'display data entered in CSV format back to client browser
    
      STDOUT "<table border=1>"
      FOR x = 1 TO Number_Of_Input_Fields
        IF LEN(Data_Entered$(x)) THEN
          STDOUT "<TR><TD>" & Field_Name$(x) & "<TD>" & Data_Entered(x)& "</TR>"
        ELSE 'no data entered so cell won't display, place a "-" into it
          STDOUT "<TR><TD>" & Field_Name$(x) & "<TD>" & "-" & "</TR>"
          STDOUT
        END IF
      NEXT
      STDOUT "</table>"
      '
      '---------------------------------------------------------------------------------
      'Save data input into the form to hard disk
      '
      '----------------------------------------------------------------------------------
    
      DIM FilName$,FileHandle&,Result&,Buffer$,RecordNumber&
    
      FilName = CURDIR$ + "\Confirmation.txt"
      'result = KillFile(FilName)
      FileHandle = OpenFile(FilName):IF FileHandle < 1 THEN EXIT FUNCTION
      DisplayBold "OPEN " & FilName & " FOR BINARY LOCK SHARED AS #" & FORMAT$(FileHandle) &  " " & TIME$
      STDOUT "<pre>"
    
      result = LockFile(FileHandle)                       'first lock the file
    
      buffer = csv                                        'data to write (csv file string this example)
      RecordNumber = LOF(#FileHandle) + 1                 'insert at end of file
      result = PutRecord(RecordNumber, Buffer,FileHandle)
    
      STDOUT "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  'move outside loop 4/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 DisplayBold(TEXT AS STRING)
      STDOUT "<b>" & TEXT & "</b>"   ' <b> bold  <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
    ------------------
    Last edited by Mike Doty; 15 May 2017, 07:18 PM.

    Leave a comment:


  • Mike Doty
    started a topic Internet functions to read/write binary files

    Internet functions to read/write binary files

    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).]
    Last edited by Mike Doty; 15 May 2017, 07:17 PM.
Working...
X