Author Topic: QB45 converted to QB64  (Read 3410 times)

0 Members and 1 Guest are viewing this topic.

Offline rmaki

  • Newbie
  • Posts: 2
    • View Profile
QB45 converted to QB64
« on: February 03, 2020, 09:50:01 am »
I took a QB45 application and produced a QB64 application from it over 100,000 lines of code. All the pricing was hard coded in the program so I started reading from CSV files but now I need the date from the CSV file without putting a directory to a text file and reading for the date. I found this code:

'===========================================================================
 
' Subject: GET/SET FILE DATE/TIME            Date: Unknown Date (00:00)   
' Author:  Matt Hart                         Code: QB, PDS               
' Keys:    GET,SET,FILE,DATE,TIME          Packet: DOS.ABC
'===========================================================================
' FILEDATE.BAS  by Matt Hart
'
' Gets or sets a file date/time
'
' GetFileDateTime returns the Date in MM-DD-YYYY format
'                     and the Time in HH:MM:SS
' SetFileDateTime expects the Date and Time in the same formats
 
    '$INCLUDE: 'QB.BI'    ' Use your path to QB or QBX.BI
    DEFINT A-Z
    DECLARE SUB GetFileDateTime (F$, Dat$, Tim$, Ecode%)
    DECLARE SUB SetFileDateTime (F$, Dat$, Tim$, Ecode%)
 
' ------------------------- Sample code
    F$ = LTRIM$(RTRIM$(COMMAND$))
    CALL GetFileDateTime(F$, Dat$, Tim$, Ecode)
    IF NOT Ecode THEN
           PRINT F$; " date is "; Dat$
           PRINT F$; " time is "; Tim$
    ELSE
           PRINT "1 Error = "; Ecode
           END
    END IF
    NewTim$ = "01:01:02"
    NewDat$ = "02-02-1980"
    CALL SetFileDateTime(F$, NewDat$, NewTim$, Ecode)
    IF Ecode THEN
           PRINT "2 Error = "; Ecode
           END
    END IF
    CALL GetFileDateTime(F$, Dat$, Tim$, Ecode)
    IF Ecode THEN
           PRINT "3 Error = "; Ecode
           END
    END IF
    PRINT F$; " new date is "; Dat$
    PRINT F$; " new time is "; Tim$
    CALL SetFileDateTime(F$, Dat$, Tim$, Ecode)
    IF Ecode THEN
           PRINT "4 Error = "; Ecode
           END
    END IF
    END
' ------------------------------------
 
SUB GetFileDateTime (F$, Dat$, Tim$, Ecode)
    Ecode = 0
    DIM InRegs AS RegTypeX
    DIM OutRegs AS RegTypeX
    InRegs.ax = &H3D00                          ' Open file function
    DIM FileName AS STRING * 128                ' Use fixed length
    FileName = F$ + CHR$(0)                     ' Must be ASCIIZ string
    InRegs.ds = VARSEG(FileName)                ' Fixed length makes these
    InRegs.dx = VARPTR(FileName)                ' come out right
    CALL INTERRUPTX(&H21, InRegs, OutRegs)      ' Open the file
    IF NOT OutRegs.flags THEN                   ' No error
           Handle = OutRegs.ax                     ' Save DOS file handle
           InRegs.ax = &H5700                      ' Get date/time function
           InRegs.bx = Handle
           CALL INTERRUPTX(&H21, InRegs, OutRegs)
           HMS& = OutRegs.cx                       ' Use long integer for
           IF HMS& < 0& THEN HMS& = 65536 + HMS&   ' positive numbers
           Hours = HMS& \ 2048&                    ' Hours is first 5 bits
           Minutes = (HMS& AND 2047&) \ 31&        ' Minutes is next 6 bits
           Seconds = HMS& AND 31&                  ' Seconds is last 5 bits
           H$ = LTRIM$(STR$(Hours))
           M$ = LTRIM$(STR$(Minutes)): IF LEN(M$) = 1 THEN M$ = "0" + M$
           S$ = LTRIM$(STR$(Seconds)): IF LEN(S$) = 1 THEN S$ = "0" + S$
           Tim$ = H$ + ":" + M$ + ":" + S$
           YMD& = OutRegs.dx                       ' Long int here too
           IF YMD& < 0 THEN YMD& = 65536 + YMD&    ' Convert to + if needed
           Year = 1980& + YMD& \ 512&              ' Year is first 7 bits
           Month = (YMD& AND 511&) \ 31&           ' Month is next 4 bits
           Day = YMD& AND 31&                      ' Day is last 5 bits
           Y$ = LTRIM$(STR$(Year))
           M$ = LTRIM$(STR$(Month))
           D$ = LTRIM$(STR$(Day)): IF LEN(D$) = 1 THEN D$ = "0" + D$
           Dat$ = M$ + "-" + D$ + "-" + Y$
           InRegs.ax = &H3E00                      ' Close file function
           InRegs.bx = Handle
           CALL INTERRUPTX(&H21, InRegs, OutRegs)  ' Close it
    ELSE
 
           Ecode = OutRegs.flags       ' Otherwise return error flags
    END IF
END SUB
 
SUB SetFileDateTime (F$, Dat$, Tim$, Ecode)
    Ecode = 0
    DIM InRegs AS RegTypeX
    DIM OutRegs AS RegTypeX
    InRegs.ax = &H3D00
    DIM FileName AS STRING * 128
    FileName = F$ + CHR$(0)
    InRegs.ds = VARSEG(FileName)
    InRegs.dx = VARPTR(FileName)
    CALL INTERRUPTX(&H21, InRegs, OutRegs)
    IF NOT OutRegs.flags THEN
           Handle = OutRegs.ax
           InRegs.ax = &H5701
           InRegs.bx = Handle
           Hours& = VAL(LEFT$(Tim$, 2)) * 2048&
           Minutes& = VAL(MID$(Tim$, 4, 2)) * 32&
           Seconds& = VAL(RIGHT$(Tim$, 2)) \ 2
           HMS& = Hours& + Minutes& + Seconds&
           IF HMS& > 65536 THEN
                  InRegs.cx = 65536 - HMS&
           ELSE
                  InRegs.cx = HMS&
           END IF
           Year& = (VAL(RIGHT$(Dat$, 4)) - 1980&) * 512&
           Month& = VAL(LEFT$(Dat$, 2)) * 32&
           Day& = VAL(MID$(Dat$, 4, 2))
           YMD& = Year& + Month& + Day&
           IF YMD& > 65536 THEN
                  InRegs.dx = 65536 - YMD&
           ELSE
                  InRegs.dx = YMD&
           END IF
           CALL INTERRUPTX(&H21, InRegs, OutRegs)
           InRegs.ax = &H3E00
           InRegs.bx = Handle
           CALL INTERRUPTX(&H21, InRegs, OutRegs)
    ELSE
           Ecode = OutRegs.flags
    END IF
END SUB

The problem when I run it is that the assembler is for 16 bit registers and I am using 32 or 64 with windows 7 and i5 core. Can anyone help me to figure out how the date will be returned in a longer int value from the register?

Offline QBExile

  • Newbie
  • Posts: 9
    • View Profile
Re: QB45 converted to QB64
« Reply #1 on: February 06, 2020, 07:12:44 am »
Have a look at this emulator , it may work for you.
https://pcem-emulator.co.uk/

Marked as best answer by rmaki on February 13, 2020, 05:00:05 am

Offline moises1953

  • Newbie
  • Posts: 55
    • View Profile
Re: QB45 converted to QB64
« Reply #2 on: February 08, 2020, 03:17:49 am »
You must read the windows libraries file times section: https://www.qb64.org/wiki/Windows_Libraries#File_Times, and rewrite using the windows API:
Code: QB64: [Select]
  1.  
  2. FUNCTION CreateFileA%& (BYVAL lpFileName AS _OFFSET, BYVAL dwDesiredAccess AS _UNSIGNED LONG, BYVAL dwShareMode AS _UNSIGNED LONG, BYVAL lpSecurityAttributes AS _OFFSET, BYVAL dwCreationDisposition AS _UNSIGNED LONG, BYVAL dwFlagsAndAttributes AS _UNSIGNED LONG, BYVAL hTemplateFile AS _OFFSET)
  3. FUNCTION CloseHandle& (BYVAL hObject AS _OFFSET)
  4. FUNCTION GetFileTime& (BYVAL hFile AS _OFFSET, BYVAL lpCreationTime AS _OFFSET, BYVAL lpLastAccessTime AS _OFFSET, BYVAL lpLastWriteTime AS _OFFSET)
  5. FUNCTION SetFileTime& (BYVAL hFile AS _OFFSET, BYVAL lpCreationTime AS _OFFSET, BYVAL lpLastAccessTime AS _OFFSET, BYVAL lpLastWriteTime AS _OFFSET)
  6. FUNCTION FileTimeToLocalFileTime& (BYVAL lpFileTime AS _OFFSET, BYVAL lpLocalFileTime AS _OFFSET)
  7. FUNCTION LocalFileTimeToFileTime& (BYVAL lpLocalFileTime AS _OFFSET, BYVAL lpFileTime AS _OFFSET)
  8. FUNCTION FileTimeToSystemTime& (BYVAL lpFileTime AS _OFFSET, BYVAL lpSystemTime AS _OFFSET)
  9. FUNCTION SystemTimeToFileTime& (BYVAL lpSystemTime AS _OFFSET, BYVAL lpFileTime AS _OFFSET)
  10. FUNCTION GetLastError& ()
  11.  
  12. TYPE FILETIME
  13.   dwLowDateTime AS _UNSIGNED LONG
  14.   dwHighDateTime AS _UNSIGNED LONG
  15.  

Offline rmaki

  • Newbie
  • Posts: 2
    • View Profile
Re: QB45 converted to QB64
« Reply #3 on: February 13, 2020, 08:35:33 am »
Thank you The running kernel32.dll worked great I guess this can be used for other DLLs as well.

Ron.