dirview.bas

汇编语言编的关于pbc22b.asm的小程序

'   +----------------------------------------------------------------------+
'   |                                                                      |
'   |       PBClone  Copyright (c) 1990-1993  Thomas G. Hanlin III         |
'   |                                                                      |
'   +----------------------------------------------------------------------+

' This is another simple demo of the PBClone routines.  It loads an entire
' directory into memory and displays it.

' Syntax:
'   DIRVIEW filespec

' The filespec may contain wildcards, of course.

' Typically, this would be converted to an .EXE file using these steps:
'    BC DIRVIEW/O;
'    LINK DIRVIEW/EX,,NUL,PBCLONE;

   DECLARE FUNCTION ExplainFAttr$ (Attr%, AbbrevLevel%)
   DECLARE SUB FileCount (File$, BYVAL FilAttr%, FilCount%, ErrCode%)
   DECLARE FUNCTION Int2DateSt$ (DateNr%)
   DECLARE FUNCTION Int2TimeSt$ (TimeNr%)
   DECLARE SUB LoadDirAll (File$, BYVAL FilAttr%, BYVAL DSeg%, BYVAL DOfs%, ErrCode%)

   DECLARE SUB PrintComma (Number&, FieldLen%)

   TYPE DirType
      FilAttr AS STRING * 1
      FilTime AS INTEGER
      FilDate AS INTEGER
      FilSize AS LONG
      FilName AS STRING * 12
   END TYPE

   DEFINT A-Z

   Cmd$ = LTRIM$(RTRIM$(UCASE$(COMMAND$)))
   IF LEN(Cmd$) = 0 OR INSTR(Cmd$, "/?") > 0 THEN
      PRINT "DIRVIEW: View Directory Demo for PBClone by Thomas G. Hanlin III"
      PRINT
      PRINT "Syntax:"
      PRINT "  DIRVIEW filespec
      PRINT
      PRINT "The filespec may contain wildcards."
      END
   END IF
   IF LEN(Cmd$) THEN
      File$ = Cmd$
   ELSE
      PRINT "Please provide a file specification."
      END
   END IF

   SeekAttr = 1 + 2 + 4 + 16
   FileCount File$, SeekAttr, FilCount, ErrCode
   IF ErrCode THEN
      PRINT "Invalid filespec."
      END
   ELSEIF FilCount = 0 THEN
      PRINT "No matching files."
      END
   END IF

   DIM FileList(1 TO FilCount) AS DirType
   DSeg = VARSEG(FileList(1))
   DOfs = VARPTR(FileList(1))
   LoadDirAll File$, SeekAttr, DSeg, DOfs, ErrCode

   FOR tmp = 1 TO FilCount
      PRINT FileList(tmp).FilName; "   ";
      PrintComma FileList(tmp).FilSize, 14
      PRINT "   "; Int2DateSt$(FileList(tmp).FilDate);
      PRINT "   "; Int2TimeSt$(FileList(tmp).FilTime);
      PRINT "   "; ExplainFAttr$(ASC(FileList(tmp).FilAttr), 2)
   NEXT

SUB PrintComma (Number&, FieldLen)
   N$ = LTRIM$(STR$(Number&))
   R$ = ""
   DO WHILE LEN(N$) > 3
      R$ = RIGHT$(N$, 3) + "," + R$
      N$ = LEFT$(N$, LEN(N$) - 3)
   LOOP
   IF LEN(N$) THEN R$ = N$ + "," + R$
   IF RIGHT$(R$, 1) = "," THEN R$ = LEFT$(R$, LEN(R$) - 1)
   IF LEN(R$) < FieldLen THEN
      R$ = SPACE$(FieldLen - LEN(R$)) + R$
   END IF
   PRINT R$;
END SUB