//**********************************************************************
// Use Files.utl    // Utilities for handling file related stuff
//
// By Sture Andersen
//
// Create: Wed  01-02-1998
// Update: Sat  02-05-1998 - Functions SEQ_FindFileAlongPath, SEQ_FileLineCount
//                           and SEQ_FindFileAlongDFPath added.
//         Fri  08-05-1998 - Error in cChannelAdmin fixed. Something to do with
//                           channel positions has changed between 3.0x and
//                           3.1c. On_Error trick has been taken out and a
//                           'sneak in' on the right position trick has been
//                           introduced.
//              09-07-1998 - Procedure SEQ_WriteRecordBuffer_LD added.
//              14-07-1998 - Grave error fixed in SEQ_WriteRecordBuffer_LD
//                           by J�rgen Legin and Torsten Balsl�w.
//                         - SEQ_ReadRecordBuffer_LD added
//              05-09-1998 - SEQ_ExtractPathFromFileName added
//              06-09-1998 - SEQ_DfPath fixed
//         Sun  07-02-1999 - Directory selector added. Based on work of
//                           Dennis Piccioni and Torben Lund. Function
//                           name is SEQ_SelectDirectory. Windows only!
//                         - aps.SelectDirForm class added. Windows only!
//         Fri  23-04-1999 - SEQ_DeleteFileToBin added. Based entirely on
//                           upload from Andy Kaplan
//                           (DAC NG user-contributed-files)
//         Sun  02-05-1999 - Added function SEQ_FileModTime
//         Mon  10-05-1999 - Fixes for VDF 6 (Vincent Oorsprong)
//         Mon  30-08-1999 - Function SEQ_DirectInput and SEQ_DirectOutput added
//         Wed  29-09-1999 - Function SEQ_SelectDirectory now converts to
//                           OEM before returning its value.
//         Sat  09-10-1999 - Procedures SEQ_CloseOutput, SEQ_CloseInput and
//                           SEQ_AppendOutput added.
//         Wed  01-12-1999 - Function SEQ_ReadLnProbe added.
//         Sun  06-02-2000 - Save- and OpenDialogs are now created dynamically
//                           in appropriate places
//         Sat  11-03-2000 - Fix in SEQ_FileExists
//         Wed  22-03-2000 - Function SEQ_FindFileAlongPath would cause an
//                           "Access violation" if asked to locate a file
//                           opened exclusive by an application (including the
//                           current). Fixed.
//         Mon  10-07-2000 - Function SEQ_FileSizeToString added
//         Wed  01-11-2000 - Functions SEQ_EraseFile, SEQ_CopyFile and
//                           SEQ_MoveFile added.
//         Tue  07-11-2000 - Added function SEQ_ConvertToAbsoluteFileName
//         Tue  02-01-2001 - Added procedures SEQ_AppendOutputImageClose and
//                           SEQ_AppendLineClose.
//         Thu  04-01-2001 - Added function SEQ_FindDataFileFromRootName
//         Mon  15-04-2002 - aps.dbSelectDirForm added
//         Mon  27-01-2003 - Function SEQ_SelectFileStartDir added
//         Sat  06-09-2003 - Added function SEQ_ValidateFolder
//
//**********************************************************************
use ui
Use Files.nui    // Utilities for handling file related stuff
Use MsgBox.utl   // obs procedure
Use Strings.nui  // String manipulation for VDF and 3.2
Use Dates.nui    // Date manipulation for VDF and 3.2
Use Base.nui     // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes
Use Version.nui
Use Language

#IFDEF IS$WINDOWS
 Use wvaW32fh.pkg // Package by Wil van Antwerpen from www.vdf-guidance.com
#ENDIF

#IF LNG_DEFAULT=lng_dutch
 #REPLACE t.files.Overwrite        "Overschrijven"
 #REPLACE t.files.Append           "Toevoegen"
 #REPLACE t.files.Warning          "Waarschuwing"
 #REPLACE t.files.FileExists       "Bestandsnaam bestaat al! (#)"
 #REPLACE t.files.SelectDrive      "Selecteer drive"
 #REPLACE t.files.Directories      "Directories"
 #REPLACE t.files.Files            "Bestanden"
 #REPLACE t.files.IllegalFn        "Geen correcte bestandsnaam"
 #REPLACE t.files.FileNotSpec      "Bestandsnaam niet ingevuld!"
 #REPLACE t.files.StopRead         "Afbreken inlezen?"
 #REPLACE t.files.FileNotFound     "# niet gevonden!"
 #REPLACE t.files.SelectDir        "Selecteer directorie"
 #REPLACE t.files.SelectFile       "Selecteer bestand"
 #REPLACE t.files.PromptDirCreate1 "Folder does not exist!"
 #REPLACE t.files.PromptDirCreate2 "Do you want to create the folder?"
 #REPLACE t.files.Error1           "A file exists with the specified name"
 #REPLACE t.files.Error2           "Folder could not be created"
 #REPLACE t.files.Error3           "A folder name must be specified"
 #REPLACE t.files.Error5           "Path not found"
#ENDIF
#IF LNG_DEFAULT=lng_spanish    // 03/10/2002 25/01/2004 Pepe Guimar�es Moose Software  pg@moose-software.com
 #REPLACE t.files.Overwrite        "Sobreescribir"
 #REPLACE t.files.Append           "Agregar al final"
 #REPLACE t.files.Warning          "Precauci�n"
 #REPLACE t.files.FileExists       "Archivo ya Existe"
 #REPLACE t.files.SelectDrive      "Unidades"
 #REPLACE t.files.Directories      "Directorios"
 #REPLACE t.files.Files            "Archivos"
 #REPLACE t.files.IllegalFn        "Nombre de Archivo no valido"
 #REPLACE t.files.FileNotSpec      "No se especific� Archivo"
 #REPLACE t.files.StopRead         "Parar lectura secuencial"
 #REPLACE t.files.FileNotFound     "# no se encontr�"
 #REPLACE t.files.SelectDir        "Elegir directorio"
 #REPLACE t.files.SelectFile       "Elegir Archivo"
 #REPLACE t.files.PromptDirCreate1 "�Carpeta inexistente!"
 #REPLACE t.files.PromptDirCreate2 "�Desea crear la carpeta?"
 #REPLACE t.files.Error1           "Ya existe un fichero con ese nombre"
 #REPLACE t.files.Error2           "No se pudo crear carpeta"
 #REPLACE t.files.Error3           "Tiene que especificar un nombre de carpeta"
 #REPLACE t.files.Error5           "Ruta (path) no encontrado"
#ENDIF
#IF LNG_DEFAULT=lng_english
 #REPLACE t.files.Overwrite        "Overwrite"
 #REPLACE t.files.Append           "Append"
 #REPLACE t.files.Warning          "Warning"
 #REPLACE t.files.FileExists       "File name already exists! (#)"
 #REPLACE t.files.SelectDrive      "Select drive"
 #REPLACE t.files.Directories      "Directories"
 #REPLACE t.files.Files            "Files"
 #REPLACE t.files.IllegalFn        "Illegal file name"
 #REPLACE t.files.FileNotSpec      "File name not specified!"
 #REPLACE t.files.StopRead         "Stop sequential read?"
 #REPLACE t.files.FileNotFound     "# not found!"
 #REPLACE t.files.SelectDir        "Select directory"
 #REPLACE t.files.SelectFile       "Select file"
 #REPLACE t.files.PromptDirCreate1 "Folder does not exist!"
 #REPLACE t.files.PromptDirCreate2 "Do you want to create the folder?"
 #REPLACE t.files.Error1           "A file exists with the specified name"
 #REPLACE t.files.Error2           "Folder could not be created"
 #REPLACE t.files.Error3           "A folder name must be specified"
 #REPLACE t.files.Error5           "Path not found"
#ENDIF
#IF LNG_DEFAULT=lng_danish
 #REPLACE t.files.Overwrite        "Overskriv"
 #REPLACE t.files.Append           "Tilf�j"
 #REPLACE t.files.Warning          "Advarsel"
 #REPLACE t.files.FileExists       "Filnavn eksisterer allerede! (#)"
 #REPLACE t.files.SelectDrive      "V�lg drev"
 #REPLACE t.files.Directories      "Mapper"
 #REPLACE t.files.Files            "Filer"
 #REPLACE t.files.IllegalFn        "Illegal file name"
 #REPLACE t.files.FileNotSpec      "Filnavn ikke specificeret!"
 #REPLACE t.files.StopRead         "Afbryd indl�sningen?"
 #REPLACE t.files.FileNotFound     "# findes ikke!"
 #REPLACE t.files.SelectDir        "V�lg bibliotek"
 #REPLACE t.files.SelectFile       "V�lg fil"
 #REPLACE t.files.PromptDirCreate1 "Mappen findes ikke!"
 #REPLACE t.files.PromptDirCreate2 "Skal mappen oprettes?"
 #REPLACE t.files.Error1           "Der findes en fil med det angivne navn"
 #REPLACE t.files.Error2           "Mappen kunne ikke oprettes"
 #REPLACE t.files.Error3           "Der skal angives et mappenavn"
 #REPLACE t.files.Error5           "Sti ikke fundet"
#ENDIF
#IF LNG_DEFAULT=lng_swedish
 #REPLACE t.files.Overwrite        "Skriv �ver"
 #REPLACE t.files.Append           "L�gg till"
 #REPLACE t.files.Warning          "Advarsel"
 #REPLACE t.files.FileExists       "Filnavn eksisterer allerede! (#)"
 #REPLACE t.files.SelectDrive      "Select drive"
 #REPLACE t.files.Directories      "Directories"
 #REPLACE t.files.Files            "Files"
 #REPLACE t.files.IllegalFn        "Illegal file name"
 #REPLACE t.files.FileNotSpec      "Filnamn ej angivet!"
 #REPLACE t.files.StopRead         "Avbryt inl�sningen?"
 #REPLACE t.files.FileNotFound     "# finns ej!"
 #REPLACE t.files.SelectDir        "V�lg bibliotek"
 #REPLACE t.files.SelectFile       "V�lg fil"
 #REPLACE t.files.PromptDirCreate1 "Folder does not exist!"
 #REPLACE t.files.PromptDirCreate2 "Do you want to create the folder?"
 #REPLACE t.files.Error1           "A file exists with the specified name"
 #REPLACE t.files.Error2           "Folder could not be created"
 #REPLACE t.files.Error3           "A folder name must be specified"
 #REPLACE t.files.Error5           "Path not found"
#ENDIF
#IF LNG_DEFAULT=lng_norwegian   // 22.04.1999 torkild.resheim@emmaedb.no
 #REPLACE t.files.Overwrite        "Overskriv"
 #REPLACE t.files.Append           "Tilf�y"
 #REPLACE t.files.Warning          "Advarsel"
 #REPLACE t.files.FileExists       "Filnavn eksisterer allerede! (#)"
 #REPLACE t.files.SelectDrive      "Velg drev"
 #REPLACE t.files.Directories      "Kataloger"
 #REPLACE t.files.Files            "Filer"
 #REPLACE t.files.IllegalFn        "Ulovlig filnavn"
 #REPLACE t.files.FileNotSpec      "Filnavn ikke spesifisert!"
 #REPLACE t.files.StopRead         "Avbryt innlesningen?"
 #REPLACE t.files.FileNotFound     "# finnes ikke!"
 #REPLACE t.files.SelectDir        "Velg katalog"
 #REPLACE t.files.SelectFile       "Velg fil"
 #REPLACE t.files.PromptDirCreate1 "Folder does not exist!"
 #REPLACE t.files.PromptDirCreate2 "Do you want to create the folder?"
 #REPLACE t.files.Error1           "A file exists with the specified name"
 #REPLACE t.files.Error2           "Folder could not be created"
 #REPLACE t.files.Error3           "A folder name must be specified"
 #REPLACE t.files.Error5           "Path not found"
#ENDIF
#IF LNG_DEFAULT=lng_german
 #REPLACE t.files.Overwrite        "�berschreiben"
 #REPLACE t.files.Append           "Anh�ngen"
 #REPLACE t.files.Warning          "Warnung"
 #REPLACE t.files.FileExists       "Bestand existiert bereits! (#)"
 #REPLACE t.files.SelectDrive      "Laufwerk ausw�hlen"
 #REPLACE t.files.Directories      "Ordner"
 #REPLACE t.files.Files            "Dateien"
 #REPLACE t.files.IllegalFn        "Ung�ltiger Dateiname"
 #REPLACE t.files.FileNotSpec      "Kein Dateiname angegeben!"
 #REPLACE t.files.StopRead         "Sequentielles Lesen abbrechen?"
 #REPLACE t.files.FileNotFound     "# nicht gefunden!"
 #REPLACE t.files.SelectDir        "Auswahl Ordner"
 #REPLACE t.files.SelectFile       "Auswahl Datei"
 #REPLACE t.files.PromptDirCreate1 "Folder does not exist!"
 #REPLACE t.files.PromptDirCreate2 "Do you want to create the folder?"
 #REPLACE t.files.Error1           "A file exists with the specified name"
 #REPLACE t.files.Error2           "Folder could not be created"
 #REPLACE t.files.Error3           "A folder name must be specified"
 #REPLACE t.files.Error5           "Path not found"
#ENDIF
#IF LNG_DEFAULT=lng_portuguese  // by Claudio Rossoni (SP-Brasil)
 #REPLACE t.files.Overwrite        "Regravar"
 #REPLACE t.files.Append           "Acrescentar"
 #REPLACE t.files.Warning          "Aten��o"
 #REPLACE t.files.FileExists       "Nome de arquivo j� existe! (#)"
 #REPLACE t.files.SelectDrive      "Selecione o drive"
 #REPLACE t.files.Directories      "Diret�rios"
 #REPLACE t.files.Files            "Arquivos"
 #REPLACE t.files.IllegalFn        "Nome de arquivo inv�lido"
 #REPLACE t.files.FileNotSpec      "Nome do arquivo n�o especificado!"
 #REPLACE t.files.StopRead         "Parar a leitura sequencial?"
 #REPLACE t.files.FileNotFound     "# n�o encontrado!"
 #REPLACE t.files.SelectDir        "Selecione o diret�rio"
 #REPLACE t.files.SelectFile       "Selecione o arquivo"
 #REPLACE t.files.PromptDirCreate1 "Folder does not exist!"
 #REPLACE t.files.PromptDirCreate2 "Do you want to create the folder?"
 #REPLACE t.files.Error1           "A file exists with the specified name"
 #REPLACE t.files.Error2           "Folder could not be created"
 #REPLACE t.files.Error3           "A folder name must be specified"
 #REPLACE t.files.Error5           "Path not found"
#ENDIF
#If LNG_DEFAULT=lng_french
 #Replace t.files.Overwrite        "Remplace"
 #Replace t.files.Append           "Ajoute"
 #Replace t.files.Warning          "Attention"
 #Replace t.files.FileExists       "Le fichier existe d�j� ! (#)"
 #Replace t.files.SelectDrive      "S�lection du disque"
 #Replace t.files.Directories      "R�pertoires"
 #Replace t.files.Files            "Fichiers"
 #Replace t.files.IllegalFn        "Nom de fichier incorrect"
 #Replace t.files.FileNotSpec      "Nom de fichier manquant!"
 #Replace t.files.StopRead         "Arr�t de la lecture?"
 #Replace t.files.FileNotFound     "# non trouv�!"
 #Replace t.files.SelectDir        "S�lection du r�pertoire"
 #Replace t.files.SelectFile       "S�lection du fichier"
 #REPLACE t.files.PromptDirCreate1 "Folder does not exist!"
 #REPLACE t.files.PromptDirCreate2 "Do you want to create the folder?"
 #REPLACE t.files.Error1           "A file exists with the specified name"
 #REPLACE t.files.Error2           "Folder could not be created"
 #REPLACE t.files.Error3           "A folder name must be specified"
 #REPLACE t.files.Error5           "Path not found"
#ENDIF
#IF LNG_DEFAULT=lng_italian	// by Paolo Zanni (Italia)
 #REPLACE t.files.Overwrite   	"Sovrascrive"
 #REPLACE t.files.Append      	"Aggiunge"
 #REPLACE t.files.Warning     	"Attenzione"
 #REPLACE t.files.FileExists  	"Il File esiste gia'! (#)"
 #REPLACE t.files.SelectDrive 	"Seleziona Drive"
 #REPLACE t.files.Directories 	"Directory"
 #REPLACE t.files.Files       	"File"
 #REPLACE t.files.IllegalFn   	"Nome File non valido"
 #REPLACE t.files.FileNotSpec  	"Nome File mancante!"
 #REPLACE t.files.StopRead     	"Stop sequential read?"
 #REPLACE t.files.FileNotFound 	"# non trovato!"
 #REPLACE t.files.SelectDir    	"Seleziona directory"
 #REPLACE t.files.SelectFile   	"Seleziona file"
 #REPLACE t.files.PromptDirCreate1 "La cartella non esiste!"
 #REPLACE t.files.PromptDirCreate2 "Vuoi creare la cartella?"
 #REPLACE t.files.Error1           "File gia' esistente con questo nome"
 #REPLACE t.files.Error2           "La cartella non pu� essere creata"
 #REPLACE t.files.Error3           "Indicare il nome della cartella"
 #REPLACE t.files.Error5           "Percorso non trovato"
#ENDIF

#IFDEF IS$WINDOWS
 Use File_Dlg   // DAC package
 integer oSEQ_OpenFlDlg# oSEQ_SaveFlDlg#
 move 0 to oSEQ_OpenFlDlg#
 move 0 to oSEQ_SaveFlDlg#
 class cSEQ_OpenFlDlg is a OpenDialog
   procedure construct_object
     forward send construct_object
     set NoChangeDir_State to true
     set HideReadOnly_State To True
     move self to oSEQ_OpenFlDlg#
   end_procedure
   procedure set Dialog_Caption string lsCaption
     #IFDEF IS$NEW$FMAC // VDF 6
     #ELSE
      move (APS_OemToChar(lsCaption)) to lsCaption
     #ENDIF
     forward set Dialog_Caption to lsCaption
   end_procedure
 end_class
 class cSEQ_SaveFlDlg is a SaveAsDialog
   procedure construct_object
     forward send construct_object
     set NoChangeDir_State to true
     set HideReadOnly_State To True
     move self to oSEQ_SaveFlDlg#
   end_procedure
   procedure set Dialog_Caption string lsCaption
     #IFDEF IS$NEW$FMAC // VDF 6
     #ELSE
      move (APS_OemToChar(lsCaption)) to lsCaption
     #ENDIF
     forward set Dialog_Caption to lsCaption
   end_procedure
 end_class

 procedure SEQ_Prepare_OpenDialog global
   local integer parent# self#
   move (focus(desktop)) to parent#
   ifnot parent# move desktop to parent#
   if oSEQ_OpenFlDlg# send request_destroy_object to oSEQ_OpenFlDlg#
   move self to self#
   move parent# to self
   object oSEQ_OpenFlDlg is a cSEQ_OpenFlDlg
   end_object
   move self# to self
 end_procedure

 procedure SEQ_Prepare_SaveDialog global
   local integer parent# self#
   move (focus(desktop)) to parent#
   ifnot parent# move desktop to parent#
   if oSEQ_SaveFlDlg# send request_destroy_object to oSEQ_SaveFlDlg#
   move self to self#
   move parent# to self
   object oSEQ_SaveFlDlg is a cSEQ_SaveFlDlg
   end_object
   move self# to self
 end_procedure

 //declare C structure struct_browseinfo
 //as documented in MSDN under Windows Shell API
 Type tFilesBrowseInfo
   Field tFilesBrowseInfo.hWndOwner      as handle
   Field tFilesBrowseInfo.pIDLRoot       as Pointer
   Field tFilesBrowseInfo.pszDisplayName as Pointer
   Field tFilesBrowseInfo.lpszTitle      as Pointer
   Field tFilesBrowseInfo.ulFlags        as dWord
   Field tFilesBrowseInfo.lpfnCallback   as Pointer
   Field tFilesBrowseInfo.lParam         as dWord
   Field tFilesBrowseInfo.iImage         as dWord
 End_Type  // tFilesBrowseInfo

 External_Function FilesSHBrowseForFolder   "SHBrowseForFolder"   shell32.dll pointer lpdWordx returns dWord
 External_Function FilesSHGetPathFromIDList "SHGetPathFromIDList" shell32.dll pointer pidList pointer lpBuffer returns dWord
 External_Function FilesCoTaskMemFree       "CoTaskMemFree"       ole32.dll   pointer pv returns Integer

 // If function ConvertChar is not already defined we define it here:
 #IFDEF get_ConvertChar
 #ELSE
  Function ConvertChar Global integer bToAnsi String sString Returns String
    Local Pointer psString
    Local Integer iVoid bIsCString
    Move (ascii(Right(sString,1))=0) to bIsCString
    If Not bISCString Append sString (character(0))
    GetAddress Of sString To psString
    if bToAnsi Move (OEMToANSI(psString,psString)) To iVoid
    else       Move (ANSItoOEM(psString,psString)) To iVoid
    Function_Return (if(bIsCString, sString, cstring(sString)))
  End_Function
 #ENDIF

 // returns folder name if a folder was selected, otherwise returns ""
 function SEQ_SelectDirectory global string lsCaption returns string
   local string sFolder sBrowseInfo sTitle sRval
   local pointer lpItemIdList lpsFolder lpsBrowseInfo lpsTitle
   local integer iFolderSelected iObj iRetval

   // fill string variable with null characters
   ZeroType tFilesBrowseInfo to sBrowseInfo

   if (lsCaption<>"") begin
     move (ConvertChar(1,lsCaption)) to sTitle // toAnsi
     GetAddress of sTitle to lpsTitle
     put lpsTitle to sBrowseInfo at tFilesBrowseInfo.lpszTitle
   end

   put (window_handle(focus(desktop))) to sBrowseInfo at tFilesBrowseInfo.hWndOwner

   GetAddress of sBrowseInfo to lpsBrowseInfo

   // null 128 chars into var (make space)
   move (repeat(character(0), 128)) to sFolder
   GetAddress of sFolder to lpsFolder

   // select folder
   move (FilesSHBrowseForFolder(lpsBrowseInfo)) to lpItemIdList
   // get selected folder name
   move (FilesSHGetPathFromIDList(lpItemIdList, lpsFolder)) to iFolderSelected

   // free memory and IDL
   Move (FilesCoTaskMemFree(lpItemIdList)) To iRetval

   if (iFolderSelected<>0) move (CString(sFolder)) to sRval
   else move "" to sRval
   function_return (ConvertChar(0,sRval))
 End_Function  // GetSelectFolder

 class aps.SelectDirForm is a aps.Form
   procedure construct_object
     forward send construct_object
     property string pSelectDialogCaption public t.files.SelectDir
     set form_button item 0 to 1           // Manually add a prompt button
     set form_button_value item 0 to "..." //              "
     on_key kprompt send prompt
   end_procedure
   procedure OnDirectorySelected
   end_procedure
   Procedure Prompt
     Local string sDir
     move (SEQ_SelectDirectory(pSelectDialogCaption(self))) to sDir
     if sDir ne "" begin
       set Value item 0 to sDir
       send OnDirectorySelected
     end
   End_Procedure
   procedure form_button_notification integer itm#
     send prompt
   end_procedure
 end_class
 class aps.dbSelectDirForm is a aps.dbForm
   procedure construct_object
     forward send construct_object
     property string pSelectDialogCaption public t.files.SelectDir
//   set form_button item 0 to 1           // Manually add a prompt button
//   set form_button_value item 0 to "..." //              "
     set prompt_button_mode to PB_PromptOn
     on_key kprompt send prompt
   end_procedure
   procedure OnDirectorySelected
   end_procedure
   Procedure Prompt
     Local string sDir
     move (SEQ_SelectDirectory(pSelectDialogCaption(self))) to sDir
     if sDir ne "" begin
       set changed_value item 0 to sDir
       send OnDirectorySelected
     end
   End_Procedure
   procedure form_button_notification integer itm#
     send prompt
   end_procedure
 end_class
 class aps.SelectFileForm is a aps.Form
   procedure construct_object
     forward send construct_object
     property string psFileMask public ""
     property string pSelectDialogCaption public t.files.SelectFile
     set form_button item 0 to 1           // Manually add a prompt button
     set form_button_value item 0 to "..." //              "
     on_key kprompt send prompt
   end_procedure
   Procedure Prompt
     Local string fn#
     get SEQ_SelectInFile (pSelectDialogCaption(self)) (psFileMask(self)) to fn#
     if fn# ne ""  set Value item 0 to fn#
   End_Procedure
   procedure form_button_notification integer itm#
     send prompt
   end_procedure
 end_class
#ELSE
 Use App.utl      // Character Mode classes
 Use Buttons.utl  // Button texts

/oSelectDirPanel.hdr
��____________________________________________����������ͻ
/oSelectDirPanel.frm
�                                                        �
� Enter directory:                                       �
� _____________________________________________________  �
�                                                        �
�                                                        �
/oSelectDirPanel.btn
�                           _____________ _____________  �
��������������������������������������������������������ͼ
/*
 object oSelectDirPanel is a app.ModalClient oSelectDirPanel.hdr
   set location to 6 10 absolute
   set window_color item 0 to 2
   on_key ksave_record send ok
   on_key kcancel send cancel
   object oFrm is a Form oSelectDirPanel.frm
     set location to 1 0 relative
     item_list
       on_item "" send next
     end_item_list
   end_object
   object oBtn is a app.Button oSelectDirPanel.btn
     set location to 6 0 relative
     item_list
       on_item t.btn.ok     send ok
       on_item t.btn.cancel send cancel
     end_item_list
   end_object
   function sPopup.s string lsCaption returns string
     local integer rval#
     local string lsDir
     set value item 0 to (lsCaption+"��������������������������������������������������������������")
     ui_accept self to rval#
     if rval# eq MSG_OK begin
       get value of (oFrm(self)) item 0 to lsDir
       if (SEQ_FileExists(lsDir)=SEQIT_DIRECTORY) function_return lsDir
     end
     function_return ""
   end_function
 end_object // oSelectDirPanel


 function SEQ_SelectDirectory global string lsCaption returns string
   function_return (sPopup.s(oSelectDirPanel(self),lsCaption))
 end_function


 #IFDEF _UNIX_
 #ELSE
/DriveSelect.hdr
��________________������ͻ
/DriveSelect.lst
�                        �
�  __ __ __ __ __ __ __  �
�  __ __ __ __ __ __ __  �
�  __ __ __ __ __ __ __  �
�                        �
/DriveSelect.btn
� ________ _____________ �
������������������������ͼ
/*
  object oSEQ_DrDlg is a app.ModalClient DriveSelect.hdr
    set location   to 6 25
    set ring_state to true
    set window_color item 0 to 2
    set value item 0 to (t.files.SelectDrive+"             ")
    on_key kcancel send cancel
    on_key ksave_record send ok
    object oList is a List DriveSelect.lst
      set location to 1 0 relative
      procedure fill_list.s string current#
        local integer len# pos# error#
        local string drives# drive#
        send delete_data
        move "ABCDEFGHIJKLMNOPQRSTUVWXYZ" to drives#
        move (length(drives#)) to len#
        for pos# from 1 to len#
          move (mid(drives#,1,pos#)) to drive#
          valid_drive drive# error#
          ifnot error# begin
            send add_item msg_ok (drive#+":")
            if drive# eq current# set current_item to (item_count(self)-1)
          end
        loop
      end_procedure
    end_object
    object oBtn is a app.Button DriveSelect.btn
      set location to 6 0 relative
      item_list
         on_item t.btn.ok     send ok
         on_item t.btn.cancel send cancel
      end_item_list
    end_object
    function sRun.s string drive# returns string
      local integer grb#
      send fill_list.s to (oList(self)) drive#
      ui_accept self to grb#
      if grb# eq msg_ok move (left(value(oList(self),current),1)) to drive#
      else move "" to drive#
      function_return drive#
    end_function
  end_object
 #ENDIF

/FileSelect.hdr
��________________________________________________________���ͻ
/FileSelect.frm
� ���������������������������������������������������������Ŀ �
� �  ______________________________________________________ � �
� �  ______________________________________________________ � �
� ����������������������������������������������������������� �
/FileSelect.ttl
� ��_______________�����������Ŀ  ��__________________�����Ŀ �
/FileSelect.filelst
� � _________________________  �
� � _________________________  �
� � _________________________  �
� � _________________________  �
� � _________________________  �
� � _________________________  �
� � _________________________  �
� � _________________________  �
� � _________________________  �
� � _________________________  �
� � _________________________  �
� ������������������������������
/FileSelect.dirlst
  �________________________ � �
  �________________________ � �
  �________________________ � �
  �________________________ � �
  �________________________ � �
  �________________________ � �
  �________________________ � �
  ��������������������������� �
                              �
                              �
                              �
                              �
/FileSelect.btn
�                                _____________ _____________  �
�������������������������������������������������������������ͼ
/*

 register_object oBtn
 object oSEQ_FlDlg is a app.ModalClient FileSelect.hdr
   set location to 3 4 absolute
   set ring_state to true
   set window_color item 0 to 2
   on_key kcancel send cancel
   on_key ksave_record send request_ok
   on_key kexit_application send cancel
   property integer pOutfile_State public false

   object oSelection is a Form FileSelect.frm
     set location to 1 0 relative

     procedure activating
       local string dir#
       forward send activating
       get_current_directory to dir#
       set value item 1 to dir#
       send fill_list
     end_procedure

     function path returns string
       local string path# dir_sep#
       move (value(self,1)) to path#
       move (sysconf(sysconf_dir_separator)) to dir_sep# // "/" or "\"
       if (right(path#,1)<>dir_sep#) append path# dir_sep#
       function_return path#
     end_function

     function Mask returns string
       function_return (value(self,0))
     end_function

     procedure New_Path string Dir_Name#
       set value item 1 to Dir_Name#
     end_procedure

     item_list
       on_item "" send fill_list
       on_item "" send select_drive
       set entry_state item 1 to false
     end_item_list
   end_object

   procedure select_drive
     #IFDEF _UNIX_
     #ELSE
      local string drive# dir#
      move (left(path(oSelection(self)),1)) to drive#
      get sRun.s of (oSEQ_DrDlg(self)) drive# to drive#
      if drive# ne "" begin
        get_directory drive# dir#
        send New_Path to (oSelection(self)) dir#
        send fill_list
      end
     #ENDIF
   end_procedure

   object oTitles is a Form FileSelect.ttl
     set location to 5 0 relative
     set focus_mode to pointer_only
     item_list
       on_item (t.files.Files      +"���������������������" ) send none
       on_item (t.files.Directories+"���������������������" ) send none
     end_item_list
     set window_color item 0 to 2
     set window_color item 1 to 2
   end_object

   object oFileList is a List FileSelect.filelst
     set location to 6 0 relative
     set Select_Mode to Auto_Select

     procedure fill_list
       local string str# str2#
       set dynamic_update_state to false
       send delete_data
       direct_input channel 0 ("DIR:"+path(oSelection(self))+mask(oSelection(self)))
       repeat
         readln channel 0 str#
         if [not seqeof] begin
           trim str# to str#
           if (left(str#,1)<>"[") begin
             #IFDEF _UNIX_
              #IF FILES$UNIX_DIR_DRIVER_ERROR_FIX
               direct_input channel 1 ("DIR:"+path(oSelection(self))+str#+"/*")
               if [~seqeof] begin
                 readln channel 1 str2#
                 if str2# ne "[.]" send add_item msg_ok str#
               end
               else send add_item msg_ok str#
               close_input channel 1
              #ELSE
               send add_item msg_ok str#
              #ENDIF
             #ELSE
              send add_item msg_ok str#
             #ENDIF
           end
         end
       until [seqeof]
       close_input channel 0
       send sort_items ascending
       set dynamic_update_state to true
       if (pOutfile_State(self)) set shadow_state of (oBtn(self)) item 0 to false
       else set shadow_state of (oBtn(self)) item 0 to (not(item_count(self)))
     end_procedure
   end_object

   object oDirList is a List FileSelect.dirlst
     Set Select_Mode to No_Select
     set location to 6 32 relative

     procedure goto_item string str#
       local integer max# itm#
       get item_count to max#
       move 0 to itm#
       repeat
         if (value(self,itm#)) eq str# set current_item to itm#
         increment itm#
       until (itm#>max#-1)
     end_procedure

     procedure change
       local string new# previous#
       local integer pos#
       move (value(self,CURRENT)) to new#
       If (new#="..") Begin
         move (path(oSelection(self))) to new#
         if new# ne "/" begin // Excludes backing from the (UNIX) root
           move (length(new#)-1) to pos#
           while (pos(mid(new#,1,pos#),"\/:")<1)
             decrement pos#
           loop
           send new_path to (oSelection(self)) (left(new#,pos#))
           move (right(new#,length(new#)-pos#)) to previous#
           move (left(previous#,length(previous#)-1)) to previous#
         end
       end
       else send New_Path to (oSelection(self)) (path(oSelection(self))+new#)
       send fill_list to (parent(self))
       if previous# ne "" send goto_item previous#
     end_procedure

     procedure fill_list // Directories
       local string str# str2#
       set dynamic_update_state to false
       send delete_data
       #IFDEF _UNIX_
        direct_input channel 0 ("DIR:"+path(oSelection(self))+"*")
       #ELSE
        direct_input channel 0 ("DIR:"+path(oSelection(self))+"")
       #ENDIF
       repeat
         readln channel 0 str#
         if [not seqeof] begin
           trim str# to str#
           if (left(str#,1)="[") begin // Directory name
             mid str# to str# (length(str#) - 2) 2
             if (str#<>".") send add_item msg_change str#
           end
           #IFDEF _UNIX_
            #IF FILES$UNIX_DIR_DRIVER_ERROR_FIX
              else begin
                direct_input channel 1 ("DIR:"+path(oSelection(self))+str#+"/*")
                [~seqeof] begin
                  readln channel 1 str2#
                  if str2# eq "[.]" send add_item msg_change str#
                end
                close_input channel 1
              end
            #ENDIF
           #ENDIF
         end
       until [seqeof]
       close_input channel 0
       send sort_items ascending
       set dynamic_update_state to true
     end_procedure
   end_object

   object oBtn is a app.Button FileSelect.btn
     set location to 18 0 relative
     item_list
        on_item t.btn.ok     send request_ok
        on_item t.btn.cancel send cancel
     end_item_list
   end_object

   procedure request_ok
     if (pOutfile_State(self)) procedure_return msg_ok
     if (item_count(oFileList(self))) procedure_return msg_ok
   end_procedure

   procedure fill_list
     send fill_list to (oDirList(self))
     send fill_list to (oFileList(self))
   end_procedure

   function SingleSelect.sss string lsCaption string filter# string dir# returns string
     local integer grb#
     local string rval#
     set pOutfile_State to false
     set value item 0 to (lsCaption+"�����������������������������������������������")
     if "|" in filter# move (ExtractWord(filter#,"|",2)) to filter#
     set value of (oSelection(self)) item 0 to filter#
     set value of (oSelection(self)) item 1 to dir#
     send fill_list
     ui_accept self to grb#
     if grb# eq msg_ok move (path(oSelection(self))+value(oFileList(self),current)) to rval#
     else move "" to rval#
     send delete_data to (oDirList(self))
     send delete_data to (oFileList(self))
     function_return rval#
   end_function

   function SingleSelect.ss string lsCaption string filter# returns string
     local string dir#
     get_current_directory to dir#
     function_return (SingleSelect.sss(self,lsCaption,filter#,dir#))
   end_function

   function SelectOutFile.sss string lsCaption string filter# string dir# returns string
     local integer grb# error#
     local string rval# path# mask#
     set pOutfile_State to true
     set value item 0 to (lsCaption+"�����������������������������������������������")
     if "|" in filter# move (ExtractWord(filter#,"|",2)) to filter#
     set value of (oSelection(self)) item 0 to filter#
     set value of (oSelection(self)) item 1 to dir#
     send fill_list
     ui_accept self to grb#
     if grb# eq msg_ok begin
       get path of (oSelection(self)) to path#
       get mask of (oSelection(self)) to mask#
       move 0 to error#
       if mask# eq "" move 1 to error#
       if "*" in mask# move 1 to error#
       if "?" in mask# move 1 to error#
       if error# begin
         send obs t.files.IllegalFn
         function_return ""
       end
       move (path#+mask#) to rval#
     end
     else move "" to rval#
     send delete_data to (oDirList(self))
     send delete_data to (oFileList(self))
     function_return rval#
   end_function

   function SelectOutFile.ss string lsCaption string filter# returns string
     local string dir#
     get_current_directory to dir#
     function_return (SelectOutFile.sss(self,lsCaption,filter#,dir#))
   end_function
 end_object
#ENDIF

function SEQ_SelectOutFile global string lsCaption string filter# returns string
  local string fn#
  #IFDEF IS$WINDOWS
   send SEQ_Prepare_SaveDialog
   #IFDEF ghoWorkSpace // If VDF5 and using workspaces
    If (ghoWorkSpace AND NoChangeDir_State(oSEQ_SaveFlDlg#) AND Initial_Folder(oSEQ_SaveFlDlg#)='') ; // if workspace exists
        Set Initial_Folder of oSEQ_SaveFlDlg# to (CurrentDataPath(ghoWorkSpace))
    Else Set Initial_Folder of oSEQ_SaveFlDlg# to ''
   #ENDIF
   set NoChangeDir_State of oSEQ_SaveFlDlg# to True
   set Dialog_Caption of oSEQ_SaveFlDlg# to lsCaption
   set Filter_String of oSEQ_SaveFlDlg# to filter#
   if (Show_Dialog(oSEQ_SaveFlDlg#)) move (File_Name(oSEQ_SaveFlDlg#)) to fn#
   else move "" to fn#
  #ELSE
   move (SelectOutFile.ss(oSEQ_FlDlg(self),lsCaption,filter#)) to fn#
  #ENDIF
  function_return fn#
end_function

// Example of filter# values for VDF program:   "Text files|*.txt|XML files|*.xml|All files|*.*"

function SEQ_SelectOutFileStartDir global string lsCaption string filter# string lsStartDir returns string
  local string fn#
  #IFDEF IS$WINDOWS
   send SEQ_Prepare_SaveDialog
   set Initial_Folder of oSEQ_SaveFlDlg# to lsStartDir
   set NoChangeDir_State of oSEQ_SaveFlDlg# to True
   set Dialog_Caption of oSEQ_SaveFlDlg# to lsCaption
   set Filter_String of oSEQ_SaveFlDlg# to filter#
   if (Show_Dialog(oSEQ_SaveFlDlg#)) move (File_Name(oSEQ_SaveFlDlg#)) to fn#
   else move "" to fn#
  #ELSE
   move (SelectOutFile.ss(oSEQ_FlDlg(self),lsCaption,filter#)) to fn#
  #ENDIF
  function_return fn#
end_function

function SEQ_SelectInFile global string lsCaption string filter# returns string
  local string fn#
  #IFDEF IS$WINDOWS
   send SEQ_Prepare_OpenDialog
   #IFDEF ghoWorkSpace // If VDF5+6+7 (not 8) and using workspaces
     Set Initial_Folder of oSEQ_OpenFlDlg# to ''
   #ENDIF
   set NoChangeDir_State of oSEQ_OpenFlDlg# to True
   set Dialog_Caption of oSEQ_OpenFlDlg# to lsCaption
   set Filter_String of oSEQ_OpenFlDlg# to filter#
   if (Show_Dialog(oSEQ_OpenFlDlg#)) move (File_Name(oSEQ_OpenFlDlg#)) to fn#
   else move "" to fn#
  #ELSE
   move (SingleSelect.ss(oSEQ_FlDlg(self),lsCaption,filter#)) to fn#
  #ENDIF
  function_return fn#
end_function

function SEQ_SelectFile global string lsCaption string filter# returns string
  function_return (SEQ_SelectInFile(lsCaption,filter#))
end_function

function SEQ_SelectFileStartDir global string lsCaption string filter# string dir# returns string
  local string fn#
  #IFDEF IS$WINDOWS
   send SEQ_Prepare_OpenDialog
   set Initial_Folder of oSEQ_OpenFlDlg# to dir#
   set NoChangeDir_State of oSEQ_OpenFlDlg# to True //False
   set Dialog_Caption of oSEQ_OpenFlDlg# to lsCaption
   set Filter_String of oSEQ_OpenFlDlg# to filter#
   if (Show_Dialog(oSEQ_OpenFlDlg#)) move (File_Name(oSEQ_OpenFlDlg#)) to fn#
   else move "" to fn#
  #ELSE
   move (SingleSelect.sss(oSEQ_FlDlg(self),lsCaption,filter#,dir#)) to fn#
  #ENDIF
  function_return fn#
end_function

//[found ~found] begin
//  files$nothing: return
//end

#IFDEF IS$WINDOWS
 use APS
 use Wait.utl
 object oFn_Exists is a aps.ModalPanel label t.files.Warning
   on_key kCancel send fn_cancel
   property integer pResult public 0
   object oMsg is a aps.TextBox
     set p_fixed_width to 240
     set justification_mode to (JMODE_CENTER+JMODE_WRAP+JMODE_VCENTER)
   end_object
   procedure fn_Append
     set pResult to 1
     send close_panel
   end_procedure
   procedure fn_OverWr
     set pResult to 2
     send close_panel
   end_procedure
   procedure fn_Cancel
     set pResult to 3
     send close_panel
   end_procedure
   object oBtn_Over is a aps.Multi_Button
     on_item t.files.Overwrite send fn_overwr
   end_object
   object oBtn_Append is a aps.Multi_Button
     on_item t.files.Append send fn_append
   end_object
   object oBtn_Cancel is a aps.Multi_Button
     on_item t.btn.cancel send fn_cancel
   end_object
   send aps_locate_multi_buttons
   function iRun.si string file_name# integer allow_append# returns integer
     local integer rval#
     //set shadow_state of (Btn(self)) item 1 to (not(allow_append#))
     set value of (oMsg(self)) to (replace("#",t.files.FileExists,file_name#))
     send popup
     get pResult to rval#
     if rval# eq 3 move 0 to rval#
     function_return rval#
   end_function
 end_object
#ELSE
/FileExists.hdr
�������������������������������������������ͻ
�                                           �
� _________________________________________ �
� _________________________________________ �
�                                           �
/FileExists.btn
� _____________ _____________ _____________ �
�������������������������������������������ͼ
/*
 object oFn_Exists is a app.ModalClient FileExists.hdr
   set center_state item 0 to true
   set center_state item 1 to true
   set value item 0 to t.files.Warning
   set window_color to item 0 2
   set window_color to item 1 2
   set location to 7 17 absolute
   procedure fn_Append
     procedure_return 1
   end_procedure
   procedure fn_OverWr
     procedure_return 2
   end_procedure
   procedure fn_Cancel
     procedure_return 3
   end_procedure
   object oBtn is a app.Button FileExists.btn
     on_key kcancel send fn_Cancel
     set location to 5 0 relative
     item_list
       on_item t.files.Overwrite send fn_overwr
       on_item t.files.Append    send fn_append
       on_item t.btn.cancel      send fn_cancel
     end_item_list
   end_object
   function iRun.si string file_name# integer allow_append# returns integer
     local integer rval#
     set shadow_state of (oBtn(self)) item 1 to (not(allow_append#))
     set value item 1 to ("("+file_name#+")")
     ui_accept self object to rval#
     if rval# eq 3 move 0 to rval#
     function_return rval#
   end_function
 end_object
#ENDIF

//         Return value: 0=cancel, 1=append, 2=overwrite
function SEQ_Filename_Exists_Action global string file_name# integer allow_append# returns integer
  function_return (iRun.si(oFn_Exists(self),file_name#,allow_append#))
end_function

procedure SEQ_WriteGridItems global integer ch# integer obj#
  local integer itm# max# shadow# checkbox# select# aux# msg#
  get item_count of obj# to max#
  writeln channel ch# max#
  for itm# from 0 to (max#-1)
    writeln (value(obj#,itm#))
    get checkbox_item_state of obj# item itm# to checkbox#
    get select_state        of obj# item itm# to select#
    #IFDEF IS$WINDOWS
     get item_shadow_state  of obj# item itm# to shadow#
    #ELSE
     get shadow_state       of obj# item itm# to shadow#
    #ENDIF
    get aux_value of obj# item itm# to aux#
    get message of obj# item itm# to msg#
    writeln checkbox#
    writeln select#
    writeln shadow#
    writeln aux#
    writeln msg#
  loop
end_procedure

procedure SEQ_ReadGridItems global integer ch# integer obj#
  local integer itm# max# shadow# checkbox# select# aux# msg#
  local string value#
  send delete_data to obj#
  readln channel ch# max#
  for itm# from 0 to (max#-1)
    readln value#
    readln checkbox#
    readln select#
    readln shadow#
    readln aux#
    readln msg#
    send add_item to obj# msg# value#
    set checkbox_item_state of obj# item itm# to checkbox#
    set select_state        of obj# item itm# to select#
    #IFDEF IS$WINDOWS
     set item_shadow_state of obj# item itm# to shadow#
    #ELSE
     set shadow_state of obj# item itm# to shadow#
    #ENDIF
    set aux_value of obj# item itm# to aux#
  loop
  set dynamic_update_state of obj# to true
end_procedure

#IFDEF IS$WINDOWS // This portion is taken from Andy Kaplans

 define xFO_MOVE               for |CI$0001
 define xFO_COPY               for |CI$0002
 define xFO_DELETE             for |CI$0003
 define xFO_RENAME             for |CI$0004

 define xFOF_MULTIDESTFILES    for |CI$0001
 define xFOF_CONFIRMMOUSE      for |CI$0002
 define xFOF_SILENT            for |CI$0004  // don't create progress/report
 define xFOF_RENAMEONCOLLISION for |CI$0008
 define xFOF_NOCONFIRMATION    for |CI$0010  // Don't prompt the user.
 define xFOF_WANTMAPPINGHANDLE for |CI$0020  // Fill in SHFILEOPSTRUCT.hNameMappings
                                            // Must be freed using SHFreeNameMappings
 define xFOF_ALLOWUNDO         for |CI$0040
 define xFOF_FILESONLY         for |CI$0080  // on *.*, do only files
 define xFOF_SIMPLEPROGRESS    for |CI$0100  // means don't show names of files
 define xFOF_NOCONFIRMMKDIR    for |CI$0200  // don't confirm making any needed dirs

 Type tFILES_SHFILEOPSTRUCT
   Field files_hWnd                   as Handle
   Field files_wFunc                  as Integer
   Field files_pFrom                  as Pointer
   Field files_pTo                    as Pointer
   Field files_fFlags                 as Short
   Field files_fAnyOperationsAborted  as Short
   Field files_hNameMappings          as Pointer
   Field files_lpszProgressTitle      as Pointer // only used if xFOF_SIMPLEPROGRESS
 End_Type

 External_Function FILES_SHFileOperation "SHFileOperationA" Shell32.dll ;
         pointer lpFileOp returns integer

 procedure SEQ_DeleteFileToBin global string fn#
   Local String  strFileOpt
   Local Pointer lpFileOpt lpFileName
   ZeroType tFILES_SHFILEOPSTRUCT to strFileOpt
   Put xFO_DELETE to strFileOpt at files_wFunc
   GetAddress of fn# to lpFileName
   Put lpFileName to strFileOpt at files_pFrom
   Put (xFOF_SILENT ior xFOF_NOCONFIRMATION ior xFOF_ALLOWUNDO) to strFileOpt at files_fFlags
   GetAddress of strFileOpt to lpFileOpt
   Move (FILES_SHFileOperation(lpFileOpt)) to strmark
 end_procedure

#ENDIF // Andy Kaplan

class cSEQ_FileReader is a TS_TimeEstimator
  procedure construct_object integer img#
    forward send construct_object img#

    property integer pReadCount      public 0  // record counter (lines or records)
    property string  pFileName       public "" // name of input file
    property integer pChannel        public 0  // input channel
    property integer pPrevPos        public 0  // last record was read starting
                                               // in this channel position
    property integer pRejectRecord   public 0  //

    property date    pReadDate       public 0  // Date and time of read
    property string  pReadTime       public "" // initialization

    property integer pOkToCancel     public 1  // Ok to interrupt?
    property string  pCancelQuestion public t.files.StopRead

    property integer piInterrupted   public 0
  end_procedure

  procedure display_init
  end_procedure
  procedure display_update
  end_procedure

  function iPreconditions_Direct_Input returns integer
    local integer fn_ok# file_size# ch# itm#
    local string fn#

    get pChannel to ch#
    get pFileName to fn#
    trim fn# to fn#
    if fn# eq "" send obs t.files.FileNotSpec
    direct_input channel ch# fn#
    [ SeqEof] move 0 to fn_ok#
    [~SeqEof] move 1 to fn_ok#
    close_input
    ifnot fn_ok# begin
      send obs (replace("#",t.files.FileNotFound,fn#))
      function_return 0
    end
    else begin
      append_output channel ch# fn#
      get_channel_position ch# to file_size#
      set piMin to 0
      set piMax to file_size#
      close_output channel ch#
    end

    set piInterrupted to 0
    function_return 1
  end_function

  function iDirect_Input returns integer
    local integer ch#
    local string fn#
    if (iPreconditions_Direct_Input(self)) begin
      send display_init
      get pChannel to ch#
      get pFileName to fn#
      direct_input channel ch# fn#
      set pReadCount to 0 // initialize counter
      set pReadDate to (dSysDate())
      set pReadTime to (sSysTime())
      set pPrevPos to 0
      function_return 1
    end
    function_return 0
  end_function

  procedure read_reset
    set_channel_position (pChannel(self)) to (pPrevPos(self))
  end_procedure

  procedure read_header returns integer // augment this
    procedure_return 0
  end_procedure

  procedure read_one returns integer // augment this
    procedure_return 1
  end_procedure

  function iUserInterrupt returns integer
    #IFDEF IS$WINDOWS
    #ELSE
     local integer rval#
     if (pOkToCancel(self)) begin // only if ok to interrupt
       keycheck
       [keypress] begin
         send TS_pause
         move (MB_Verify(pCancelQuestion(self),0)) to rval#
         if rval# set piInterrupted to true
         send TS_Continue
         function_return rval#
       end
     end
     function_return 0
    #ENDIF
  end_function

  procedure roll_back // augment this to undo the effect
  end_procedure       // of a interrupted read

  procedure read_begin
  end_procedure
  procedure read_end
  end_procedure

  procedure run string fn#
    local integer finish# ch# PrevPos#
    if Num_Arguments gt 0 set pFileName to fn#
    if (iDirect_Input(self)) begin
      get pChannel to ch#
      send read_begin
      get msg_read_header to finish#
      ifnot finish# begin
        repeat
          set pRejectRecord to false
          get msg_read_one to finish#
          ifnot finish# begin
            get_channel_position ch# to PrevPos#
            set pPrevPos to PrevPos#
            set pReadCount to (pReadCount(self)+1)
            send display_update
          end
          if (iUserInterrupt(self)) move 1 to finish# // keypress
          if (piInterrupted(self))  move 1 to finish# // program interrupt
        until finish#
      end
      close_input channel ch#
      send read_end
      if (piInterrupted(self)) send roll_back
    end
  end_procedure
end_class // cSEQ_FileReader

#IFDEF IS$WINDOWS
//  cbject files.FileNameForm is a aps.Form
//  end_class
#ENDIF

#IFDEF IS$WINDOWS
 define xMAX_PATH for 200
 External_function Files_GetWindowsDirectory "GetWindowsDirectoryA" kernel32.dll Pointer lpBuffer Integer nSize returns integer
 function SEQ_WindowsDirectory global returns string
   local string sVal
   local integer iGrb
   local pointer pVal
   ZeroString xMAX_PATH to sVal
   GetAddress of sVal to pVal
   move (Files_GetWindowsDirectory(pVal, xMAX_PATH)) to iGrb
  function_return sVal
 end_function
#ENDIF

enumeration_list
  define VALIDFOLDER_CREATE_FALSE
  define VALIDFOLDER_CREATE_PROMPT
  define VALIDFOLDER_CREATE_QUIET
end_enumeration_list
enumeration_list
  define VALIDFOLDER_EXISTS                // The folder exists
  define VALIDFOLDER_NAME_IS_FILE          // The specified name points to a file
  define VALIDFOLDER_CREATION_FAILED       // Folder could not be created
  define VALIDFOLDER_NO_FOLDER_SPECIFIED   // Folder not specified
  define VALIDFOLDER_USER_CANCEL           // User cancelled directory create
  define VALIDFOLDER_PARENT_PATH_NOT_FOUND // Path to parent folder not found
  define VALIDFOLDER_PATH_NOT_FOUND        // Path to parent folder not found
end_enumeration_list

function SEQ_ValidateFolder_ErrorText global integer liError returns string
  if (liError=VALIDFOLDER_EXISTS)                function_return ""
  if (liError=VALIDFOLDER_NAME_IS_FILE)          function_return t.files.Error1
  if (liError=VALIDFOLDER_CREATION_FAILED)       function_return t.files.Error2
  if (liError=VALIDFOLDER_NO_FOLDER_SPECIFIED)   function_return t.files.Error3
  if (liError=VALIDFOLDER_PATH_NOT_FOUND)        function_return t.files.Error5
  if (liError=VALIDFOLDER_PARENT_PATH_NOT_FOUND) function_return t.files.Error5
end_function

function SEQ_ValidateFolder global string lsFolder integer liAllowCreate integer lbNoErrorMsg returns integer
  local integer liError liExists lbCreate liGarbage
  local string lsParentFolder lsError
  move (trim(lsFolder)) to lsFolder
  if (lsFolder="") move VALIDFOLDER_NO_FOLDER_SPECIFIED to liError // Error: No folder specified
  else begin
    if (length(lsFolder)>1 and right(lsFolder,2)=(":"+sysconf(SYSCONF_DIR_SEPARATOR))) ;
                                               move (StringLeftBut(lsFolder,1)) to lsFolder
    get SEQ_FileExists lsFolder to liExists
    if (liExists=SEQIT_FILE) move VALIDFOLDER_NAME_IS_FILE to liError // Error: it's a file
    else begin
      if (liExists=SEQIT_DIRECTORY) move VALIDFOLDER_EXISTS to liError // All is well!
      else begin
        if (liAllowCreate<>VALIDFOLDER_CREATE_FALSE) begin
          get SEQ_ExtractPathFromFileName lsFolder to lsParentFolder
          get SEQ_FileExists lsParentFolder to liExists // Does parent folder exist?
          if (liExists=SEQIT_DIRECTORY) begin
            if (liAllowCreate=VALIDFOLDER_CREATE_PROMPT) get MB_Verify4 t.files.PromptDirCreate1 ("("+lsFolder+")") t.files.PromptDirCreate2 "" 1 to lbCreate
            else move 1 to lbCreate
            if lbCreate begin
#IFDEF IS$WINDOWS
              get wvaWin32_CreateDirectory (ToAnsi(lsFolder)) to liGarbage
#ELSE
              send obs "Only the Windows version is able to create directories" "(files.utl)"
#ENDIF
              get SEQ_FileExists lsFolder to liExists // Does the folder exist now?
              if (liExists=SEQIT_DIRECTORY) move VALIDFOLDER_EXISTS to liError
              else move VALIDFOLDER_CREATION_FAILED to liError
            end
            else move VALIDFOLDER_USER_CANCEL to liError
          end
          else move VALIDFOLDER_PARENT_PATH_NOT_FOUND to liError
        end
        else move VALIDFOLDER_PATH_NOT_FOUND to liError
      end
    end
  end
  ifnot lbNoErrorMsg begin
    get SEQ_ValidateFolder_ErrorText liError to lsError
    if (liError=VALIDFOLDER_NAME_IS_FILE)          send obs lsError lsFolder
    if (liError=VALIDFOLDER_CREATION_FAILED)       send obs lsError lsFolder
    if (liError=VALIDFOLDER_NO_FOLDER_SPECIFIED)   send obs lsError
    if (liError=VALIDFOLDER_PARENT_PATH_NOT_FOUND) send obs lsError lsParentFolder
    if (liError=VALIDFOLDER_PATH_NOT_FOUND)        send obs lsError lsFolder
  end
  function_return liError
end_function // SEQ_ValidateFolder