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

 Return to Index  

Ok, new code with changes mentionned here.

June 5 2007 at 7:34 AM
  (Login MystikShadows)
R


Response to LOL alrighty ;-)

 
1. Adapted Extraction routines to skip over the \Current folder
2. Adjusted menu selection routine to finish accommodating keeping menu bar and menu options in sync when scrolling list up or down.
3. Change the means to get the model numbers as I noticed discrepencies in the new images.txt file.

For number 3. You'll notice in your file that some have GD<modelnumber>AX.gho in the first sample file they followed that. but with this new current one some have 3 letters (or more) before the actual model number (and don't have the AX at the end like the XPS adn the HP desktop example below. So I get the model number from the folder path instead. hence, for the following samples:

Z:\Current\Desktops\Gateway\Profile6\GDPR60A2.GHO
Z:\Current\Desktops\HP\DC7700\HPDC7700.GHO
Z:\Current\Laptops\Dell\370\DLD370A2.GHO
Z:\Current\Laptops\Dell\400\DLD400A1.GHO
Z:\Current\Laptops\Dell\610\DLD610A2.GHO
Z:\Current\Laptops\Dell\XPS\Test\DPP14L.GHO
Z:\Current\Laptops\Gateway\E100\GLE100A2.GHO

I will give you:
Dell
..Desktop
....370
....400
....610
....XPS
Gateway
..Desktop
....Profile6
..Laptop
....E100
HP
..Desktop
....DC7700

I just get the value of the folder after the Manufacturer which is the model folder name instead of extracting it from the file name. This should work in all situations. Copy from down here.

Let me know. Again on my sample file you just supplied it works as expected.


---------------- <you're a pro at this now I'm sure hehe> -------------------------



DECLARE FUNCTION GetModelNumber$ (FilePath AS STRING)
DEFINT A-Z

' -------------------------------
' Sub and Function declarations
' -------------------------------
DECLARE FUNCTION ExtractFileName$ (WorkPath AS STRING)
DECLARE FUNCTION GetManufacturer$ (FilePath AS STRING)
DECLARE FUNCTION GetExtraCount% ()
DECLARE SUB BuildMenuList ()
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$
WorkPos1% = INSTR(1, WorkLine$, "\")
WorkPos2% = INSTR(WorkPos1% + 1, WorkLine$, "\")
IF UCASE$(MID$(WorkLine$, WorkPos2% + 1, 1)) = "L" THEN
MyArray(Counter).ModelType = "Laptop"
ELSEIF UCASE$(MID$(WorkLine$, WorkPos2% + 1, 1)) = "D" THEN
MyArray(Counter).ModelType = "Desktop"
END IF
WorkString$ = GetModelNumber(WorkLine$)
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 Offset4 AS INTEGER
DIM Temp AS STRING

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

END FUNCTION

FUNCTION GetModelNumber$ (FilePath AS STRING)

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

Offset1 = INSTR(1, FilePath, "\")
Offset2 = INSTR(Offset1 + 1, FilePath, "\")
Offset3 = INSTR(Offset2 + 1, FilePath, "\")
Offset4 = INSTR(Offset3 + 1, FilePath, "\")
Offset5 = INSTR(Offset4 + 1, FilePath, "\")
Temp = MID$(FilePath, Offset4 + 1, Offset5 - Offset4 - 1)
GetModelNumber$ = 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 TopOffset 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(MenuArray) < 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
TopOffset = TopOffset + 1
IF MenuArray(CurrentOption).ElementType <> 3 THEN
CurrentOption = CurrentOption - 1
TopOffset = TopOffset + 1
IF MenuArray(CurrentOption).ElementType <> 3 THEN
CurrentOption = CurrentOption - 1
TopOffset = TopOffset + 1
END IF
END IF

END IF
' ------------------------------------
' Adjust list to show current option
' ------------------------------------
IF CurrentOption < TopVisible THEN
TopVisible = CurrentOption
IF TopVisible < 1 THEN
TopVisible = 1
CurrentOption = 1
END IF
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
IF TopVisible + (ListLength - 1) <> CurrentOption THEN
TopVisible = TopVisible + 1
IF TopVisible + (ListLength - 1) <> CurrentOption THEN
TopVisible = TopVisible + 1
END IF
END IF
IF TopVisible + ListLength - 1 > UBOUND(MenuArray) THEN
CurrentOption = UBOUND(MenuArray)
TopVisible = CurrentOption - (ListLength - 1)
END IF
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


 
 Respond to this message   
 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