The QBasic / QB64 Discussion Forum      Other Subforums, Links and Downloads
 

Respond to this messageReturn to Index
Original Message
  • Once again, This is the version that gets images.txt from n:
    • (Login MystikShadows)
      R
      Posted Jun 4, 2007 3:58 PM

      I keep on forgetting to uncomment the Fixed filename to get the stuff from gosh dern it!! ;-)

      DECLARE FUNCTION GetExtraCount% ()
      DECLARE SUB BuildMenuList ()
      DEFINT A-Z

      ' -------------------------------
      ' Sub and Function declarations
      ' -------------------------------
      DECLARE FUNCTION ExtractFileName$ (WorkPath AS STRING)
      DECLARE FUNCTION GetManufacturer$ (FilePath AS STRING)
      DECLARE SUB PresentModels ()
      DECLARE SUB SortModelList ()

      ' ---------------------
      ' Constant Definitons
      ' ---------------------
      CONST KeyUpArrow = 72
      CONST KeyDownArrow = 80
      CONST KeyLeftArrow = 75
      CONST KeyRightArrow = 77
      CONST KeyHome = 71
      CONST KeyEnd = 79

      ' --------------------
      ' User Defined Types
      ' --------------------
      TYPE FileData
      Manufacturer AS STRING * 15
      ModelType AS STRING * 10
      ModelNumber AS STRING * 39
      FilePath AS STRING * 150
      END TYPE

      TYPE MenuData
      ElementType AS INTEGER ' 1=manufacturer, 2=type, 3=model number
      ElementLabel AS STRING * 39
      RelatedItem AS INTEGER
      END TYPE

      DIM SHARED Counter AS INTEGER

      ' --------------------------------------------
      ' Start by Inquiring which file to read from
      ' --------------------------------------------
      WIDTH 80, 43
      CLS
      'LINE INPUT "Filename to process: "; FileName$
      FileName$ = "N:\images.txt"
      ' --------------------------------
      ' Get Number Of Files to process
      ' --------------------------------
      FileHandle = FREEFILE
      OPEN FileName$ FOR INPUT AS #FileHandle
      Counter = 0
      DO WHILE NOT EOF(FileHandle)
      LINE INPUT #FileHandle, WorkLine$
      Counter = Counter + 1
      LOOP
      CLOSE #FileHandle

      ' --------------------------------------
      ' Populate Array with initial contents
      ' --------------------------------------
      DIM SHARED MyArray(Counter) AS FileData
      Counter = 1


      ' -----------------------------------------------------
      ' Popular MyArray() with model numbers and file paths
      ' -----------------------------------------------------
      OPEN FileName$ FOR INPUT AS #FileHandle
      DO WHILE NOT EOF(FileHandle)
      LINE INPUT #FileHandle, WorkLine$
      WorkString$ = RTRIM$(WorkLine$)
      FileName$ = ExtractFileName$(WorkString$) ' Get File name
      Manufacturer$ = GetManufacturer(WorkLine$)
      MyArray(Counter).Manufacturer = Manufacturer$
      IF UCASE$(MID$(WorkLine$, 4, 1)) = "L" THEN
      MyArray(Counter).ModelType = "Laptop"
      ELSEIF UCASE$(MID$(WorkLine$, 4, 1)) = "D" THEN
      MyArray(Counter).ModelType = "Desktop"
      END IF
      WorkString$ = LEFT$(FileName$, LEN(FileName$) - 6) ' Get An.GHO out
      WorkString$ = RIGHT$(WorkString$, LEN(WorkString$) - 2) ' Get 2 letter prefix out
      MyArray(Counter).FilePath = WorkLine$
      MyArray(Counter).ModelNumber = WorkString$
      Counter = Counter + 1
      LOOP
      CLOSE #FileHandle
      WorkCount% = GetExtraCount%
      DIM SHARED MenuArray(Counter + WorkCount%) AS MenuData

      CALL SortModelList ' Sort Files by Manufacturer
      CALL BuildMenuList ' Get Menu List ready


      ' ----------------------------------------------------
      ' Present the user with the list built from the file
      ' ----------------------------------------------------
      CALL PresentModels

      SUB BuildMenuList

      'DIM SHARED MenuArray(IndexCount) AS MenuData
      '
      IndexCount = UBOUND(MyArray) + ExtraCount
      ArrayCount = 1
      ' ------------------------------------
      ' Add Default Item And Start Of List
      ' ------------------------------------
      MenuArray(1).ElementType = 3
      MenuArray(1).ElementLabel = "Run Ghost Utility"
      MenuArray(1).RelatedItem = 0
      MenuArray(2).ElementType = 3
      MenuArray(2).ElementLabel = "Go directly to DOS prompt"
      MenuArray(2).RelatedItem = 0
      MenuArray(3).ElementType = 1
      MenuArray(3).ElementLabel = STRING$(39, CHR$(205))
      MenuArray(3).RelatedItem = 0
      MenuArray(4).ElementType = 1
      MenuArray(4).ElementLabel = MyArray(ArrayCount).Manufacturer
      MenuArray(4).RelatedItem = 0
      MenuArray(5).ElementType = 2
      MenuArray(5).ElementLabel = " " + MyArray(ArrayCount).ModelType
      MenuArray(5).RelatedItem = 0
      MenuArray(6).ElementType = 3
      MenuArray(6).ElementLabel = " " + MyArray(ArrayCount).ModelNumber
      MenuArray(6).RelatedItem = ArrayCount
      IndexCount = 7
      FOR FileCounter = 2 TO UBOUND(MyArray)
      IF MyArray(FileCounter).Manufacturer = MyArray(FileCounter - 1).Manufacturer AND MyArray(FileCounter).ModelType = MyArray(FileCounter - 1).ModelType THEN
      MenuArray(IndexCount).ElementType = 3
      MenuArray(IndexCount).ElementLabel = " " + MyArray(FileCounter).ModelNumber
      MenuArray(IndexCount).RelatedItem = FileCounter
      IndexCount = IndexCount + 1
      ELSE
      IF MyArray(FileCounter).Manufacturer = MyArray(FileCounter - 1).Manufacturer AND MyArray(FileCounter).ModelType <> MyArray(FileCounter - 1).ModelType THEN
      MenuArray(IndexCount).ElementType = 2
      MenuArray(IndexCount).ElementLabel = " " + MyArray(FileCounter).ModelType
      MenuArray(IndexCount).RelatedItem = 0
      MenuArray(IndexCount + 1).ElementType = 3
      MenuArray(IndexCount + 1).ElementLabel = " " + MyArray(FileCounter).ModelNumber
      MenuArray(IndexCount + 1).RelatedItem = FileCounter
      IndexCount = IndexCount + 2
      ELSE
      IF MyArray(FileCounter).Manufacturer <> MyArray(FileCounter - 1).Manufacturer THEN
      MenuArray(IndexCount).ElementType = 1
      MenuArray(IndexCount).ElementLabel = MyArray(FileCounter).Manufacturer
      MenuArray(IndexCount).RelatedItem = 0
      MenuArray(IndexCount + 1).ElementType = 2
      MenuArray(IndexCount + 1).ElementLabel = " " + MyArray(FileCounter).ModelType
      MenuArray(IndexCount + 1).RelatedItem = 0
      MenuArray(IndexCount + 2).ElementType = 3
      MenuArray(IndexCount + 2).ElementLabel = " " + MyArray(FileCounter).ModelNumber
      MenuArray(IndexCount + 2).RelatedItem = FileCounter
      IndexCount = IndexCount + 3
      END IF
      END IF
      END IF
      NEXT FileCounter

      END SUB

      FUNCTION ExtractFileName$ (WorkPath AS STRING)

      DIM TempPath AS STRING
      DIM WorkPos AS INTEGER
      DIM Offset AS INTEGER
      WorkPos = 1
      WorkPos = INSTR(1, WorkPath, "\")
      DO WHILE WorkPos > 0
      Offset = WorkPos + 1
      WorkPos = INSTR(Offset, WorkPath, "\")
      LOOP
      TempPath = RIGHT$(WorkPath, LEN(WorkPath) - (Offset - 1))
      ExtractFileName$ = TempPath

      END FUNCTION

      FUNCTION GetExtraCount%


      DIM FileCounter AS INTEGER
      DIM ExtraCount AS INTEGER

      ' First get list of extra elements to add
      ' -----------------------------------------
      ExtraCount = 3

      FOR FileCounter = 2 TO UBOUND(MyArray)
      PRINT MyArray(FileCounter).Manufacturer, MyArray(FileCounter - 1).Manufacturer
      IF MyArray(FileCounter).Manufacturer <> MyArray(FileCounter - 1).Manufacturer THEN
      ExtraCount = ExtraCount + 2
      ELSE
      IF MyArray(FileCounter).ModelType <> MyArray(FileCounter - 1).ModelType THEN
      ExtraCount = ExtraCount + 1
      END IF
      END IF
      NEXT FileCounter
      GetExtraCount% = ExtraCount

      END FUNCTION

      FUNCTION GetManufacturer$ (FilePath AS STRING)


      DIM Offset1 AS INTEGER
      DIM Offset2 AS INTEGER
      DIM Offset3 AS INTEGER
      DIM Temp AS STRING

      Offset1 = INSTR(1, FilePath, "\")
      Offset2 = INSTR(Offset1 + 1, FilePath, "\")
      Offset3 = INSTR(Offset2 + 1, FilePath, "\")
      Temp = MID$(FilePath, Offset2 + 1, Offset3 - Offset2 - 1)
      GetManufacturer$ = Temp

      END FUNCTION

      DEFSNG A-Z
      SUB PresentModels

      DIM MenuCounter AS INTEGER
      DIM TopVisible AS INTEGER
      DIM TopRow AS INTEGER
      DIM ListLength AS INTEGER
      DIM CurrentOption AS INTEGER
      DIM MenuOffset AS INTEGER
      DIM CommandString AS STRING



      COLOR 7, 1
      CLS
      ' ----------------------
      ' Setup Initial Values
      ' ----------------------
      ListLength = 37
      TopRow = 3
      TopVisible = 1
      ' -----------------------
      ' Draw Selection Screen
      ' -----------------------
      LOCATE 1, 1: COLOR 0, 7
      PRINT SPACE$(80);
      LOCATE 1, 1: PRINT TAB(27); "Please make your selection";
      LOCATE 43, 1: COLOR 0, 7
      PRINT SPACE$(80);
      LOCATE 43, 1: PRINT TAB(8); "<Up/Down/Home/End> Navigate menu - <Enter> Make your selection";
      ' ----------------------
      ' Draw Box Around Menu
      ' ----------------------
      COLOR 0, 7
      LOCATE TopRow, 19: PRINT CHR$(201) + STRING$(39, CHR$(205)) + CHR$(187)
      FOR x = TopRow + 1 TO 40
      LOCATE x, 19
      PRINT CHR$(186) + STRING$(39, " ") + CHR$(186)
      NEXT x
      LOCATE 41, 19: PRINT CHR$(200) + STRING$(39, CHR$(205)) + CHR$(188)
      CurrentOption = 1
      Keyboard$ = ""
      DO WHILE CanExit = 0
      ' ----------------------
      ' Display Menu Options
      ' ----------------------
      IF UBOUND(MyArray) < ListLength THEN
      ' -------------------------------------
      ' If less elements than visible lines
      ' -------------------------------------
      FOR MenuCounter = 1 TO UBOUND(MenuArray)
      LOCATE 3 + MenuCounter, 20
      IF MenuCounter = CurrentOption THEN
      IF MenuArray(MenuCounter).ElementType = 1 THEN
      COLOR 15, 0
      ELSEIF MenuArray(MenuCounter).ElementType = 2 THEN
      COLOR 15, 0
      ELSE
      COLOR 11, 0
      END IF
      ELSE
      IF MenuArray(MenuCounter).ElementType = 1 THEN
      COLOR 0, 7
      ELSEIF MenuArray(MenuCounter).ElementType = 2 THEN
      COLOR 0, 7
      ELSE
      COLOR 1, 7
      END IF
      END IF
      PRINT MenuArray(MenuCounter).ElementLabel
      NEXT MenuCounter
      ELSE
      ' -------------------------------------
      ' If more elements than visible lines
      ' -------------------------------------
      FOR MenuCounter = TopVisible TO TopVisible + ListLength - 1
      MenuOffset = TopVisible
      LOCATE 3 + ((MenuCounter - MenuOffset) + 1), 20
      IF MenuCounter = CurrentOption THEN
      IF MenuArray(MenuCounter).ElementType = 1 THEN
      COLOR 15, 0
      ELSEIF MenuArray(MenuCounter).ElementType = 2 THEN
      COLOR 15, 0
      ELSE
      COLOR 11, 0
      END IF
      ELSE
      IF MenuArray(MenuCounter).ElementType = 1 THEN
      COLOR 0, 7
      ELSEIF MenuArray(MenuCounter).ElementType = 2 THEN
      COLOR 0, 7
      ELSE
      COLOR 1, 7
      END IF
      END IF
      PRINT MenuArray(MenuCounter).ElementLabel
      NEXT MenuCounter
      END IF
      ' ----------------------
      ' Wait for a keystroke
      ' ----------------------
      DO WHILE Keyboard$ = ""
      Keyboard$ = INKEY$
      LOOP
      ' ----------------------------------------------------
      ' Execute appropriate action based on Keyboard input
      ' ----------------------------------------------------
      SELECT CASE Keyboard$
      CASE CHR$(0) + CHR$(KeyUpArrow)
      CurrentOption = CurrentOption - 1
      IF CurrentOption < 1 THEN
      CurrentOption = 1
      END IF
      IF MenuArray(CurrentOption).ElementType <> 3 THEN
      CurrentOption = CurrentOption - 1
      IF MenuArray(CurrentOption).ElementType <> 3 THEN
      CurrentOption = CurrentOption - 1
      IF MenuArray(CurrentOption).ElementType <> 3 THEN
      CurrentOption = CurrentOption - 1
      END IF
      END IF

      END IF
      ' ------------------------------------
      ' Adjust list to show current option
      ' ------------------------------------
      IF CurrentOption < TopVisible THEN
      TopVisible = TopVisible - 1
      END IF
      CASE CHR$(0) + CHR$(KeyDownArrow)
      CurrentOption = CurrentOption + 1
      IF CurrentOption > UBOUND(MenuArray) THEN
      CurrentOption = UBOUND(MenuArray)
      END IF
      IF MenuArray(CurrentOption).ElementType <> 3 THEN
      CurrentOption = CurrentOption + 1
      IF MenuArray(CurrentOption).ElementType <> 3 THEN
      CurrentOption = CurrentOption + 1
      IF MenuArray(CurrentOption).ElementType <> 3 THEN
      CurrentOption = CurrentOption + 1
      END IF
      END IF

      END IF
      ' ------------------------------------
      ' Adjust list to show current option
      ' ------------------------------------
      IF CurrentOption > TopVisible + ListLength - 1 THEN
      TopVisible = TopVisible + 1
      END IF
      CASE CHR$(0) + CHR$(KeyHome)
      CurrentOption = 1
      TopVisible = 1
      CASE CHR$(0) + CHR$(KeyEnd)
      CurrentOption = UBOUND(MenuArray)
      TopVisible = CurrentOption - (ListLength - 1)
      CASE CHR$(13)
      SELECT CASE CurrentOption
      CASE 1
      ' -------------------
      ' Run Ghost utility
      ' -------------------
      SHELL "Z:\Ghost\Ghost.exe -fni"
      CASE 2
      ' ------------------
      ' Go to DOS Prompt
      ' ------------------
      COLOR 7, 0
      CLS
      SYSTEM
      CASE ELSE
      ' ----------------------------------------
      ' Execute Ghost with right path/file
      ' ----------------------------------------
      SHELL "Z:\Ghost\GDisk /i 1 /del /all /sure"
      SHELL "Z:\Ghost\ghost.exe -fni -clone,mode=load,src=" + RTRIM$(MyArray(MenuArray(CurrentOption).RelatedItem).FilePath) + ",dst=1 -sure -rb -batch:"


      END SELECT
      CASE CHR$(27)
      CanExit = 1
      COLOR 7, 0
      CLS
      END SELECT
      ' -----------------------------------
      ' Clear the keyboard$ for next loop
      ' -----------------------------------
      Keyboard$ = ""
      LOOP
      END SUB

      DEFINT A-Z
      SUB SortModelList

      DIM Outer AS INTEGER
      DIM Inner AS INTEGER

      FOR Outer = 1 TO UBOUND(MyArray) - 1
      FOR Inner = Outer + 1 TO UBOUND(MyArray)
      IF MyArray(Outer).Manufacturer > MyArray(Inner).Manufacturer THEN
      SWAP MyArray(Outer), MyArray(Inner)
      END IF
      NEXT Inner
      NEXT Outer

      END SUB

    Login Status
  • You are not logged in
    • Login
      Password
       

      Optional
      Provides additional benefits such as notifications, signatures, and user authentication.


      Create Account
    Your Name
    Your Email
    (Optional)
    Message Title
    Message Text
    Options Also send responses to my email address
          


     Copyright © 1999-2014 Network54. All rights reserved.   Terms of Use   Privacy Statement  

    Newbies usually go to www.qbasic.com and click on The QBasic Forum
    Forum regulars have their own ways, which include The QBasic Community Forums