// Use Files.nui // Utilities for handling file related stuff (No User Interface) // Sat 06-09-2003 - From 9.1 direct_input/direct_output and // append_output performs OEM to versions. // This is now reflected in the code (search _91_) // Wed 10-09-2003 - Added procedure SEQ_ReadRecordBufferToArray_LD // - Added function SEQ_InputChannelLineCount (and taken out again) // Mon 12-01-2004 - Function SEQ_CurrentFolder added // Thu 15-01-2004 - Procedure SEQ_CallBack_ItemsInDir no longer loads [.] and [..] items // - Function SEQ_NumberFiles now takes a parameter. // Sat 15-02-2004 - A long time Oem/ANSI issue with respect to filenames in DIRECT_INPUT/ // DIRECT_OUTPUT commands, that was apparently fixed in 9.1 beta, was // un-fixed in the final 9.1 release. Therefore the original fix to the // problem has been re-introduced (look for _91_) // Mon 01-03-2004 - Function SEQ_FindFileAlongPath has been fixed to let it handle // UNC pathing. // More exotic file functions may be found in the following packages: // // Use files01.nui // SEQ_DoChannelPositionsToLineCount - stuff // Use Seq_Chnl // Defines global sequential device management operations (DAW) Use Strings.nui // String manipulation for VDF and 3.2 Use Base.nui // Item_Property command, Various macros (FOR_EX...), cArray, cSet and cStack classes Use Dates.nui // Date routines Use ErrorHnd.nui // cErrorHandlerRedirector class and oErrorHandlerQuiet object Use Version.nui #IFDEF IS$WINDOWS use WinFolder.nui // WinFolder_ReadFolder message #ENDIF #IFDEF _UNIX_ #REPLACE FILES$UNIX_DIR_DRIVER_ERROR_FIX 0 // DAW fixed it #ELSE #REPLACE FILES$UNIX_DIR_DRIVER_ERROR_FIX 0 #ENDIF string giSeq$Temp 250 function SEQ_UniqueFileName global string lsPreFix returns string local integer count# unique# loop# ch# move (left(trim(lsPreFix),4)) to lsPreFix move 12 to count# // max number of retries move 1 to loop# get Seq_New_Channel to ch# // This method and Seq_Release_Channel are if ch# lt 0 function_return "" // located in seq_chnl.pkg send Seq_Release_Channel ch# // We only need it for a second repeat move (random(9999)) to unique# direct_input channel ch# (lsPreFix+string(unique#)+".tmp") move (count#-1) to count# [seqeof] move 0 to loop# if loop# if count# le 0 move 0 to loop# close_input channel ch# until (not(loop#)) if count# le 0 function_return "" // failure function_return (lsPreFix+string(unique#)+".tmp") end_function string SEQ_UniqueFileNamePath$ext 5 move "tmp" to SEQ_UniqueFileNamePath$ext function SEQ_UniqueFileNamePath global string lsPath string lsPreFix returns string local integer count# unique# loop# ch# local string lsFileName if (lsPath="." or lsPath="") get SEQ_CurrentFolder to lsPath move (left(trim(lsPreFix),4)) to lsPreFix move 12 to count# // max number of retries move 1 to loop# get Seq_New_Channel to ch# // This method and Seq_Release_Channel are if ch# lt 0 function_return "" // located in seq_chnl.pkg send Seq_Release_Channel ch# // We only need it for a second repeat move (random(9999)) to unique# get SEQ_ComposeAbsoluteFileName lsPath (lsPreFix+string(unique#)+"."+SEQ_UniqueFileNamePath$ext) to lsFileName direct_input channel ch# lsFileName move (count#-1) to count# [seqeof] move 0 to loop# if loop# if count# le 0 move 0 to loop# close_input channel ch# until (not(loop#)) if count# le 0 function_return "" // failure function_return lsFileName end_function function SEQ_UniqueFileNamePathAndExt global string lsPath string lsPreFix string lsExt returns string local string lsRval move lsExt to SEQ_UniqueFileNamePath$ext get SEQ_UniqueFileNamePath lsPath lsPreFix to lsRval move "tmp" to SEQ_UniqueFileNamePath$ext function_return lsRval end_function define FS_KILOBYTE for 1024 define FS_MEGABYTE for 1048576 define FS_GIGABYTE for 1073741824 define SEQ_FileExists$Test for 0 #COMMAND SEQ_FileExists$Test$ShowLn #IF SEQ_FileExists$Test send obs !1 !2 !3 !4 !5 !6 !7 !8 !9 #ENDIF #ENDCOMMAND define SEQIT_NONE for 0 define SEQIT_FILE for 1 define SEQIT_DIRECTORY for 2 #IFDEF _UNIX_ function SEQ_FileExists global string lsFile returns integer local integer liChannel lbSeqEof local string lsValue if (lsFile="") function_return SEQIT_NONE get Seq_New_Channel to liChannel send Seq_Release_Channel liChannel // Does it exist as a file? direct_input channel liChannel lsFile move (seqeof) to lbSeqEof close_input channel liChannel ifnot lbSeqEof function_return SEQIT_FILE // We found it, therefore it is a file // We did not find anything, therefore it may be a directory: get Files_AppendPath lsFile "*" to lsFile direct_input channel liChannel ("DIR:"+lsFile) // Linux dir driver is nothing to write home about! readln channel liChannel lsValue // We have to read a line before we can trust SEQEOF move (seqeof) to lbSeqEof close_input channel liChannel ifnot lbSeqEof function_return SEQIT_DIRECTORY function_return SEQIT_NONE // But it wasn't end_function #ELSE function SEQ_FileExists global string lsFile returns integer local integer liRval liChannel local string lsStr if lsFile eq "" function_return SEQIT_NONE get Seq_New_Channel to liChannel // This method and Seq_Release_Channel are if liChannel lt 0 function_return 1 // located in seq_chnl.pkg SEQ_FileExists$Test$ShowLn "1 SEQ_FileExists:" (">"+lsFile+"<") "on channel " liChannel #IFDEF IS$WINDOWS // #IF (_VERSION_<_91_) direct_input channel liChannel ("DIR:"+StringOemToAnsi(lsFile)) // #ELSE // direct_input channel liChannel ("DIR:"+lsFile) // #ENDIF #ELSE direct_input channel liChannel ("DIR:"+lsFile) #ENDIF move (not(seqeof)) to liRval SEQ_FileExists$Test$ShowLn "2 (liRval): " liRval ifnot liRval begin get SEQ_ExtractPathFromFileName lsFile to lsStr SEQ_FileExists$Test$ShowLn "3 (lsStr): " lsStr if lsStr eq "" begin // There's no path in the file name get SEQ_FindFileAlongDFPath lsFile to lsStr SEQ_FileExists$Test$ShowLn "4 (lsStr): " lsStr if lsStr ne "" begin get SEQ_ComposeAbsoluteFileName lsStr lsFile to lsFile SEQ_FileExists$Test$ShowLn "5 (lsFile): " lsFile close_input channel liChannel send Seq_Release_Channel liChannel // We only need it for a second function_return (SEQ_FileExists(lsFile)) end end end SEQ_FileExists$Test$ShowLn "7 (liRval): " liRval if liRval begin // Item exists! Is it a directory? move SEQIT_FILE to liRval readln channel liChannel lsStr if (left(lsStr,1)="[") move SEQIT_DIRECTORY to liRval SEQ_FileExists$Test$ShowLn "8 (liRval): " liRval SEQ_FileExists$Test$ShowLn "9 (lsStr): " lsStr end close_input channel liChannel send Seq_Release_Channel liChannel // We only need it for a second function_return liRval end_function #ENDIF function SEQ_FileSize global string fn# returns number // This function returns the size of file in bytes. local integer ch# local number rval# ifnot (SEQ_FileExists(fn#)) function_return 0 get Seq_New_Channel to ch# send Seq_Release_Channel ch# #IFDEF IS$WINDOWS // #IF (_VERSION_<_91_) move (StringOemToAnsi(fn#)) to fn# // #ENDIF #ENDIF append_output channel ch# fn# get_channel_position ch# to rval# close_output channel ch# function_return rval# end_function function SEQ_SizeToStringHelp global number XB# returns string if XB# ge 1000 function_return (NumToStr(XB#,0)) if XB# ge 100 function_return (NumToStr(XB#,1)) if XB# ge 10 function_return (NumToStr(XB#,2)) function_return (NumToStr(XB#,3)) end_function function SEQ_FileSizeToString global number bytes# returns string if bytes# ge FS_GIGABYTE function_return (SEQ_SizeToStringHelp(bytes#/FS_GIGABYTE)+" GB") else if bytes# ge FS_MEGABYTE function_return (SEQ_SizeToStringHelp(bytes#/FS_MEGABYTE)+" MB") else if bytes# ge FS_KILOBYTE function_return (SEQ_SizeToStringHelp(bytes#/FS_KILOBYTE)+" KB") function_return bytes# end_function function SEQ_FileLineCount global string fn# returns integer //> This function returns the number of lines in (ascii-) file . //> Note that this function will read through the entire file (use with //> caution!). local integer rval# ch# local string str# get Seq_New_Channel to ch# send Seq_Release_Channel ch# #IFDEF IS$WINDOWS // #IF (_VERSION_<_91_) move (StringOemToAnsi(fn#)) to fn# // #ENDIF #ENDIF direct_input channel ch# fn# move 0 to rval# ifnot [seqeof] begin repeat readln str# [~seqeof] increment rval# [~seqeof] loop end close_input channel ch# function_return rval# end_function function SEQ_DirectInput global string fn# returns integer //> The function attempts to open the file fn# for sequential reading. //> If it succeeds a channel number will be returned, if it fails -1 //> will be returned. If the function succseeds it is the responsability //> of the caller to release the channel (Seq_Release_Channel) when //> done. local integer ch# get Seq_New_Channel to ch# #IFDEF IS$WINDOWS // #IF (_VERSION_<_91_) move (StringOemToAnsi(fn#)) to fn# // #ENDIF #ENDIF direct_input channel ch# fn# if (seqeof) begin send Seq_Release_Channel ch# move -1 to ch# end function_return ch# end_function procedure SEQ_CloseInput global integer ch# close_input channel ch# send Seq_Release_Channel ch# end_procedure function SEQ_DirectOutput global string fn# returns integer local integer ch# get Seq_New_Channel to ch# send ErrorHnd_Quiet_Activate #IFDEF IS$WINDOWS // #IF (_VERSION_<_91_) move (StringOemToAnsi(fn#)) to fn# // #ENDIF #ENDIF direct_output channel ch# fn# send ErrorHnd_Quiet_Deactivate if (ErrorHnd_Quiet_ErrorCount()) begin send SEQ_CloseOutput ch# move -1 to ch# end function_return ch# end_function function SEQ_AppendOutput global string fn# returns integer local integer ch# get Seq_New_Channel to ch# #IFDEF IS$WINDOWS // #IF (_VERSION_<_91_) move (StringOemToAnsi(fn#)) to fn# // #ENDIF #ENDIF append_output channel ch# fn# function_return ch# end_function function SEQ_DirectInputDBMS global integer liFile integer liField returns integer function_return (SEQ_DirectInput("DBMS:"+string(liFile)+","+string(liField))) end_function function SEQ_DirectOutputDBMS global integer liFile integer liField returns integer function_return (SEQ_DirectOutput("DBMS:"+string(liFile)+","+string(liField))) end_function procedure SEQ_CloseOutput global integer ch# close_output channel ch# send Seq_Release_Channel ch# end_procedure //> Just a small function for convenience. Sometimes it's nice not to have //> to declare a variable just to read a line in a file. Global indicator //> SeqEof will be false after calling this function if an EOF has been //> reached. function SEQ_ReadLn global integer ch# returns string local string rval# readln channel ch# rval# function_return rval# end_function //> Reads sequential channel liChannel until the value lsValue is found. //> Return value 1: OK, 0: Value not found function SEQ_ReadLnUntilValue global integer liChannel string lsValue returns integer local string lsLine repeat readln channel liChannel lsLine if (SeqEof) function_return 0 if (lsLine=lsValue) function_return 1 loop end_function //> Function SEQ_ReadLnProbe reads a line from input channel ch# without //> affecting the current channel position of that channel. The return //> value is of type string and will be the line read. The function sets //> indicator [seqeof] as a sideeffect function SEQ_ReadLnProbe global integer liChannel returns string local integer liPos lbSeqEof lbSneakMode local string lsRval lsValue get_channel_position liChannel to liPos readln channel liChannel lsRval move (seqeof) to lbSeqEof move (liPos>0) to lbSneakMode if lbSneakMode decrement liPos set_channel_position liChannel to liPos if lbSneakMode read_block channel liChannel lsValue 1 indicate seqeof as lbSeqEof ne 0 function_return lsRval end_function procedure SEQ_AppendLineClose global string lsFileName string lsLine local integer liChannel get SEQ_AppendOutput lsFileName to liChannel writeln channel liChannel lsLine send SEQ_CloseOutput liChannel end_procedure procedure SEQ_AppendOutputImageClose global string lsFileName integer liImg local integer liChannel liAuxChannel liSeqEof local string lsLine get SEQ_DirectInput ("image: "+string(liImg)) to liAuxChannel if liAuxChannel ge 0 begin get SEQ_AppendOutput lsFileName to liChannel repeat readln channel liAuxChannel lsLine move (SeqEof) to liSeqEof ifnot liSeqEof writeln channel liChannel (rtrim(lsLine)) until liSeqEof send SEQ_CloseInput liAuxChannel send SEQ_CloseOutput liChannel end end_procedure procedure SEQ_WriteImage global integer liChannel integer liImage local integer liAuxChannel liSeqEof local string lsLine get SEQ_DirectInput ("image: "+string(liImage)) to liAuxChannel if liAuxChannel ge 0 begin repeat readln channel liAuxChannel lsLine move (trim(lsLine)) to lsLine move (SeqEof) to liSeqEof ifnot liSeqEof writeln channel liChannel lsLine until liSeqEof send SEQ_CloseInput liAuxChannel end end_procedure procedure SEQ_WriteFile global integer liChannel string lsFile local integer liChannelIn liSize liIterations liRest liCount get SEQ_FileSize lsFile to liSize if liSize begin get SEQ_DirectInput ("binary:"+lsFile) to liChannelIn if liChannelIn ge 0 begin move (liSize/250) to liIterations move (liSize-(liIterations*250)) to liRest for liCount from 1 to liIterations read_block channel liChannelIn giSeq$Temp 250 write channel liChannel giSeq$Temp loop read_block channel liChannelIn giSeq$Temp liRest write channel liChannel giSeq$Temp send SEQ_CloseInput liChannelIn end end end_procedure function SEQ_FindFileAlongPath global string path# string fn# returns string //> Returns the directory along path# in which the file fn# is found. local integer ch# eof# local string str# tmp# dir_sep# path_sep# cur_dir# get Seq_New_Channel to ch# send Seq_Release_Channel ch# move (sysconf(SYSCONF_DIR_SEPARATOR)) to dir_sep# // \ move (sysconf(SYSCONF_PATH_SEPARATOR)) to path_sep# // ; move (replaces(dir_sep#,fn#,"")) to fn# while path# ne "" if path_sep# in path# begin move (left(path#,pos(path_sep#,path#)-1)) to str# replace (str#+path_sep#) in path# with "" end else begin move path# to str# move "" to path# end get Files_AppendPath str# fn# to tmp# // move (str#+dir_sep#+fn#) to tmp# // move (replaces(dir_sep#+dir_sep#,tmp#,dir_sep#)) to tmp# #IFDEF _UNIX_ direct_input channel ch# tmp# #ELSE #IFDEF IS$WINDOWS // #IF (_VERSION_<_91_) direct_input channel ch# ("DIR:"+StringOemToAnsi(tmp#)) // #ELSE // direct_input channel ch# ("DIR:"+tmp#) // #ENDIF #ELSE direct_input channel ch# ("DIR:"+tmp#) #ENDIF #ENDIF move (seqeof) to eof# close_input channel ch# ifnot eof# begin if (StringBeginsWith(str#,"."+dir_sep#)) begin get_current_directory to cur_dir# replace "." in str# with cur_dir# end function_return str# end end function_return "" // file not found! end_function function SEQ_DfPath global returns string local string path# get_attribute DF_OPEN_PATH to path# // Oem fixed! #IFDEF IS$WINDOWS move (ToOem(path#)) to path# #ENDIF function_return path# end_function function SEQ_FirstDirInDfPath global returns string local string lsDir lsPathSep get SEQ_DfPath to lsDir move (SysConf(SYSCONF_PATH_SEPARATOR)) to lsPathSep get ExtractItem lsDir lsPathSep 1 to lsDir #IFDEF IS$WINDOWS function_return (ToOem(lsDir)) #ELSE function_return lsDir #ENDIF end_function function SEQ_FindFileAlongDFPath global string fn# returns string function_return (SEQ_FindFileAlongPath(SEQ_DfPath(),fn#)) end_function //> Function SEQ_ExtractPathFromFileName expects a file name or a file //> mask as an argument. Only then will it return the path of that file. //> Otherwise it will simply strip the last directory from the path. function SEQ_ExtractPathFromFileName global string fn# returns string local string dir_sep# move (sysconf(SYSCONF_DIR_SEPARATOR)) to dir_sep# if dir_sep# in fn# function_return (StripFromLastOccurance(fn#,dir_sep#)) if ":" in fn# function_return (StripFromLastOccurance(fn#,":")) function_return "" end_function //> Function SEQ_ExtractExtensionFromFileName expects a file name or a file //> mask as an argument. Only then will it return the type of that file. function SEQ_ExtractExtensionFromFileName global string fn# returns string local string dir_sep# move (sysconf(SYSCONF_DIR_SEPARATOR)) to dir_sep# if dir_sep# in fn# move (GetFromLastOccurance(fn#,dir_sep#)) to fn# if "." in fn# function_return (replace(".",GetFromLastOccurance(fn#,"."),"")) function_return "" end_function //> Function SEQ_ExtractRootNameFromFileName expects a file name or a file !!!! //> mask as an argument. Only then will it return the rootname of that file. function SEQ_ExtractRootNameFromFileName global string fn# returns string local string dir_sep# move (sysconf(SYSCONF_DIR_SEPARATOR)) to dir_sep# if dir_sep# in fn# move (GetFromLastOccurance(fn#,dir_sep#)) to fn# if ":" in fn# move (GetFromLastOccurance(fn#,":")) to fn# if "." in fn# function_return (replace(".",StripFromLastOccurance(fn#,"."),"")) function_return fn# end_function function SEQ_RemovePathFromFileName global string fn# returns string local string dir_sep# move (sysconf(SYSCONF_DIR_SEPARATOR)) to dir_sep# if dir_sep# in fn# begin move (GetFromLastOccurance(fn#,dir_sep#)) to fn# function_return (StringRightBut(fn#,1)) end if ":" in fn# begin move (GetFromLastOccurance(fn#,dir_sep#)) to fn# move (GetFromLastOccurance(fn#,":")) to fn# end function_return fn# end_function function SEQ_TranslatePathToAbsolute global string lsPath returns string local string lsRval lsDirSep lsCurDir if lsPath eq "" move "." to lsPath move (sysconf(SYSCONF_DIR_SEPARATOR)) to lsDirSep // "/" or "\" get_current_directory to lsCurDir if (StringBeginsWith(lsPath,"."+lsDirSep)) replace "." in lsPath with lsCurDir if lsPath eq "." move lsCurDir to lsPath if (right(lsPath,1)=lsDirSep and right(lsPath,2)<>(":"+lsDirSep)) move (StringLeftBut(lsPath,1)) to lsPath function_return lsPath end_function // The SEQ_ComposeAbsoluteFileName function takes a path (without filename) // and a file name (without a path) and returns a file name including path. // It's purpose is to insert a path delimiter if necessary. function SEQ_ComposeAbsoluteFileName global string sDir string fn# returns string local string dir_sep# move (replace(SEQ_ExtractPathFromFileName(fn#),fn#,"")) to fn# // Remove path if present anyway! //move (SEQ_ExtractPathFromFileName(sDir)) to sDir move (sysconf(SYSCONF_DIR_SEPARATOR)) to dir_sep# if sDir eq "" get_current_directory to sDir if (right(sDir,1)<>dir_sep#) move (sDir+dir_sep#) to sDir function_return (sDir+fn#) end_function //> This function pretty much does the same as SEQ_ComposeAbsoluteFileName. Only //> the code is less tricky and it's got a nicer name. function Files_AppendPath global string lsPath1 string lsPath2 returns string local string lsSep move (trim(lsPath1)) to lsPath1 move (trim(lsPath2)) to lsPath2 move (sysconf(SYSCONF_DIR_SEPARATOR)) to lsSep if (right(lsPath1,1)=lsSep and left(lsPath2,1)=lsSep) move (replace(lsSep,lsPath2,"")) to lsPath2 if (lsPath1<>"" and lsPath2<>"" and right(lsPath1,1)<>lsSep and left(lsPath2,1)<>lsSep) move (lsSep+lsPath2) to lsPath2 function_return (append(lsPath1,lsPath2)) end_function // This function does the same as Files_AppendPath except here you also // pass the dir separator to the function. function Files_AppendPath_Sep global string lsPath1 string lsSep string lsPath2 returns string move (trim(lsPath1)) to lsPath1 move (trim(lsPath2)) to lsPath2 if (right(lsPath1,1)=lsSep and left(lsPath2,1)=lsSep) move (replace(lsSep,lsPath2,"")) to lsPath2 if (lsPath1<>"" and lsPath2<>"" and right(lsPath1,1)<>lsSep and left(lsPath2,1)<>lsSep) move (lsSep+lsPath2) to lsPath2 function_return (append(lsPath1,lsPath2)) end_function function SEQ_ConvertToAbsoluteFileName global string sFileName returns string local string sDir // showln "SEQ_ConvertToAbsoluteFileName " sFileName if (SEQ_FileExists(sFileName)) ne SEQIT_NONE begin // showln "Does exists" get SEQ_ExtractPathFromFileName sFileName to sDir if sDir eq "" begin get SEQ_FindFileAlongDFPath sFileName to sDir get SEQ_ComposeAbsoluteFileName sDir sFileName to sFileName end get SEQ_TranslatePathToAbsolute sFileName to sFileName end else move "" to sFileName function_return sFileName end_function //> This function really makes an effert to return the full path //> if the data file. If it cannot be determined, the empty string //> is returned. function SEQ_FindDataFileFromRootName global string lsRoot returns string local string lsExt lsPath // This procedure move (lowercase(right(lsRoot,4))) to lsExt ifnot (lsExt=".dat" or lsExt=".int") move (lsRoot+".DAT") to lsRoot if (SEQ_ExtractPathFromFileName(lsRoot)) eq "" begin move (SEQ_FindFileAlongDFPath(lsRoot)) to lsPath move (SEQ_ComposeAbsoluteFileName(lsPath,lsRoot)) to lsRoot end get SEQ_ConvertToAbsoluteFileName lsRoot to lsRoot function_return lsRoot end_function [found ~found] begin // Sneaky way of skipping code files.no$err: // This serves as an empty low-level error handler routine return end //> Function SEQ_FileModTime returns the last modified stamp of a file //> in TS format (see DATES.NUI). NOTE! File specification MUST include //> full path. function SEQ_FileModTime global string fn# returns number local integer h# m# s# err_label# local date date# local number rval# #IFDEF IS$WINDOWS move (StringOemToAnsi(fn#)) to fn# #ENDIF ifnot (SEQ_FileExists(fn#)) function_return 0 move |VI31 to err_label# //copy ON ERROR label on error gosub files.no$err // If file is open get_file_mod_time indicate err false // command will fail. get_file_mod_time fn# to date# h# m# s# // VDF6: 4358 DFRUNCON(31e): 4630 // showln "get_file_mod_time " date# " " h# " " m# " " s# indicate err false move err_label# to |VI31 //restore original ON ERROR label indicate err false move (Date2to4(date#)) to date# move (TS_Compose2(date#,h#,m#,s#)) to rval# function_return rval# end_function // SEQ_FileModTime procedure set SEQ_FileModTime global string lsFile number lnTime local integer h# m# s# err_label# liDateFormat local date date# local number rval# local string lsTime ifnot (SEQ_FileExists(lsFile)) procedure_return move |VI31 to err_label# //copy ON ERROR label on error gosub files.no$err indicate err false get TS_ExtractDate lnTime to date# get TS_ExtractTime lnTime to lsTime move (mid(lsTime,2,1)) to h# move (mid(lsTime,2,4)) to m# move (mid(lsTime,2,7)) to s# // showln "set_file_mod_time " date# " " h# " " m# " " s# get_attribute DF_DATE_FORMAT to liDateFormat // set_file_mod_time only works when dateformat is DF_DATE_USA set_attribute DF_DATE_FORMAT to DF_DATE_USA #IFDEF IS$WINDOWS move (StringOemToAnsi(lsFile)) to lsFile #ENDIF set_file_mod_time lsFile to date# h# m# s# // Faulty Faulty Faulty set_attribute DF_DATE_FORMAT to liDateFormat indicate err false move err_label# to |VI31 //restore original ON ERROR label indicate err false end_procedure // set SEQ_FileModTime procedure SEQ_CallBack_DirsInPath global string path# integer msg# integer obj# local integer pos# len# local string sep# dir# char# move (sysconf(SYSCONF_PATH_SEPARATOR)) to sep# move (length(path#)) to len# move "" to dir# for pos# from 1 to len# move (mid(path#,1,pos#)) to char# if char# eq sep# begin if dir# ne "" send msg# to obj# dir# move "" to dir# end else move (dir#+char#) to dir# loop if dir# ne "" send msg# to obj# dir# end_procedure function SEQ_RemoveRedundantDirs global string path# returns string local integer pos# len# local string sep# dir# char# rval# move (sysconf(SYSCONF_PATH_SEPARATOR)) to sep# move (length(path#)) to len# move "" to dir# move "|" to rval# for pos# from 1 to len# move (mid(path#,1,pos#)) to char# if char# eq sep# begin if dir# ne "" begin move (SEQ_TranslatePathToAbsolute(dir#)) to dir# ifnot ("|"+lowercase(dir#)+"|") in (lowercase(rval#)) move (rval#+dir#+"|") to rval# move "" to dir# end end else move (dir#+char#) to dir# loop if dir# ne "" begin move (SEQ_TranslatePathToAbsolute(dir#)) to dir# ifnot ("|"+lowercase(dir#)+"|") in (lowercase(rval#)) move (rval#+dir#+"|") to rval# end replace "|" in rval# with "" move (replaces("|",rval#,sep#)) to rval# function_return rval# end_function enumeration_list define SEQCB_FILES_ONLY define SEQCB_DIRS_ONLY define SEQCB_FILESANDDIRS end_enumeration_list desktop_section object oSEQ_CallBack_ItemsInDir is an cArray NO_IMAGE property string psPath public "" procedure add_item string str# set value item (item_count(self)) to str# end_procedure function iNumberOfItems integer lhMode returns integer local integer liMax liItm liCount get item_count to liMax decrement liMax move 0 to liCount if (lhMode=SEQCB_FILES_ONLY) begin for liItm from 0 to liMax ifnot (left(value(self,liItm),1)="[") increment liCount loop function_return liCount end if (lhMode=SEQCB_DIRS_ONLY) begin for liItm from 0 to liMax if (left(value(self,liItm),1)="[") increment liCount loop function_return liCount end if (lhMode=SEQCB_FILESANDDIRS) function_return (item_count(self)) end_function end_object end_desktop_section #IFDEF IS$WINDOWS procedure SEQ_Load_ItemsInDir global string path# send WinFolder_ReadFolder path# end_procedure function SEQ_NumberFiles global integer liMode returns integer integer lhObj move (oWinFolderEntries(self)) to lhObj if (liMode=SEQCB_FILES_ONLY ) function_return (piFileCount(lhObj)) if (liMode=SEQCB_DIRS_ONLY ) function_return (piFolderCount(lhObj)) if (liMode=SEQCB_FILESANDDIRS) function_return (piFileCount(lhObj)+piFolderCount(lhObj)) end_function procedure SEQ_CallBack_ItemsInDir global integer liMode integer lhMsg integer lhObj integer lhFolder liMax liRow lbFolder string lsName lsPath move (oWinFolderEntries(self)) to lhFolder get psFolder of lhFolder to lsPath get row_count of lhFolder to liMax decrement liMax for liRow from 0 to liMax get pbFolder.i of lhFolder liRow to lbFolder get psFileName.i of lhFolder liRow to lsName if lbFolder begin if (liMode<>SEQCB_FILES_ONLY) send lhMsg to lhObj ("["+lsName+"]") lsPath (pnFileSz.i(lhFolder,liRow)) (pnLastWrite.i(lhFolder,liRow)) end else begin if (liMode<>SEQCB_DIRS_ONLY) send lhMsg to lhObj lsName lsPath (pnFileSz.i(lhFolder,liRow)) (pnLastWrite.i(lhFolder,liRow)) end loop end_procedure #ELSE procedure SEQ_Load_ItemsInDir global string path# local integer ch1# ch2# obj# type# local string str# str2# move (oSEQ_CallBack_ItemsInDir(self)) to obj# send delete_data to obj# get Seq_New_Channel to ch1# #IFDEF IS$WINDOWS // #IF (_VERSION_<_91_) move (StringOemToAnsi(path#)) to path# // #ENDIF #ENDIF #IFDEF _UNIX_ #IF FILES$UNIX_DIR_DRIVER_ERROR_FIX get Seq_New_Channel to ch2# send Seq_Release_Channel ch2# #ENDIF #ENDIF send Seq_Release_Channel ch1# #IFDEF _UNIX_ // ifnot "*" in path# ifnot "?" in path# move (path#+"*") to path# direct_input channel ch1# ("DIR:"+path#+"/*") #ELSE direct_input channel ch1# ("DIR:"+path#) if "*" in path# move (SEQ_ExtractPathFromFileName(path#)) to path# if "?" in path# move (SEQ_ExtractPathFromFileName(path#)) to path# #ENDIF #IFDEF IS$WINDOWS // #IF (_VERSION_<_91_) set psPath of obj# to (StringAnsiToOem(path#)) // #ELSE // set psPath of obj# to path# // #ENDIF #ELSE set psPath of obj# to path# #ENDIF repeat readln channel ch1# str# if [not seqeof] begin trim str# to str# if (str#<>"[.]" and str#<>"[..]") begin #IFDEF _UNIX_ #IF FILES$UNIX_DIR_DRIVER_ERROR_FIX if (left(str#,1)="[") send add_item to obj# str# else begin // Check if it's a directory anyway direct_input channel ch2# ("DIR:"+path#+"/"+str#+"/*") [~seqeof] begin readln channel ch2# str2# if str2# eq "[.]" send add_item to obj# ("["+str#+"]") end close_input channel ch2# end #ELSE send add_item to obj# str# #ENDIF #ELSE #IFDEF IS$WINDOWS send add_item to obj# (StringAnsiToOem(str#)) #ELSE send add_item to obj# str# #ENDIF #ENDIF end end until [seqeof] close_input channel ch1# send sort_items to obj# ASCENDING end_procedure function SEQ_NumberFiles global integer liMode returns integer function_return (iNumberOfItems(oSEQ_CallBack_ItemsInDir(self),liMode)) end_function procedure SEQ_CallBack_ItemsInDir global integer liMode integer lhMsg integer lhObj local integer liItem liMax lhArr local string lsFile lsPath move (oSEQ_CallBack_ItemsInDir(self)) to lhArr get psPath of lhArr to lsPath get item_count of lhArr to liMax for liItem from 0 to (liMax-1) get value of lhArr item liItem to lsFile if liMode eq SEQCB_FILES_ONLY ifnot (left(lsFile,1)) eq "[" send lhMsg to lhObj lsFile lsPath if liMode eq SEQCB_DIRS_ONLY if (left(lsFile,1)) eq "[" send lhMsg to lhObj lsFile lsPath if liMode eq SEQCB_FILESANDDIRS send lhMsg to lhObj lsFile lsPath loop end_procedure #ENDIF desktop_section object oFileInPath is an cArray NO_IMAGE property string psFileToCheck public "" property integer piMessage public 0 property integer piObject public 0 procedure CallBack_FileInPath_Help string dir# local integer msg# obj# local string fn# get piMessage to msg# get piObject to obj# move (SEQ_ComposeAbsoluteFileName(dir#,psFileToCheck(self))) to fn# if (SEQ_FileExists(fn#)) send msg# to obj# fn# end_procedure procedure CallBack_FileInPath string file# string path# integer msg# integer obj# send delete_data set psFileToCheck to file# set piMessage to msg# set piObject to obj# send SEQ_CallBack_DirsInPath path# msg_CallBack_FileInPath_help self send delete_data end_procedure end_object end_desktop_section procedure SEQ_CallBack_FileInPath global string file# string path# integer msg# integer obj# send CallBack_FileInPath to (oFileInPath(self)) file# path# msg# obj# end_procedure // Procedure SEQ_WriteArrayItems writes the contents of an array (obj#) to // sequential channel ch#. The procedure will only produce a meaningful // result if the items of the array does not contain strings with binary data // or CR/FL characters. procedure SEQ_WriteArrayItems global integer ch# integer obj# local integer itm# max# get item_count of obj# to max# writeln channel ch# max# for itm# from 0 to (max#-1) writeln (value(obj#,itm#)) loop end_procedure // Procedure SEQ_ReadArrayItems will fill the array (obj#) with data // read from sequential channel ch#. These data must have been written // using the SEQ_WriteArrayItems procedure. procedure SEQ_ReadArrayItems global integer ch# integer obj# local integer itm# max# local string str# send delete_data to obj# get item_count of obj# to max# readln channel ch# max# for itm# from 0 to (max#-1) readln str# set value of obj# item itm# to str# loop end_procedure // Calling procedure SEQ_WriteRecordBuffer_LD will write the current // contents of the record buffer of file file# through channel ch#. // The post-fix "LD" means line delimited. procedure SEQ_WriteRecordBuffer_LD global integer ch# integer file# local integer max# field# fieldindex# filenumber# len# type# move fieldindex to fieldindex# move filenumber to filenumber# get_attribute DF_FILE_NUMBER_FIELDS of file# to max# move file# to filenumber write channel ch# // Set channel for fieldindex from 1 to max# get_attribute DF_FIELD_TYPE of file# fieldindex to type# if type# ne DF_OVERLAP begin // Do not write overlap fields if (type#=DF_BINARY or type#=DF_TEXT) begin // If TEXT or BINARY we move (length(indirect_file.recnum)) to len# // write(ln) the length writeln len# // of the field before write indirect_file.recnum // its contents. end else writeln indirect_file.recnum end loop move fieldindex# to fieldindex move filenumber# to filenumber end_procedure // Read a record from channel ch# as written by the SEQ_WriteRecordBuffer_LD // procedure. procedure SEQ_ReadRecordBuffer_LD global integer ch# integer file# local integer max# fieldindex# filenumber# len# type# move fieldindex to fieldindex# move filenumber to filenumber# get_attribute DF_FILE_NUMBER_FIELDS of file# to max# move file# to filenumber read channel ch# // Set channel for fieldindex from 1 to max# get_attribute DF_FIELD_TYPE of file# fieldindex to type# if type# ne DF_OVERLAP begin if (type#=DF_BINARY or type#=DF_TEXT) begin readln len# read_block indirect_file.recnum len# end else readln indirect_file.recnum end loop move fieldindex# to fieldindex move filenumber# to filenumber end_procedure // Reads a record like the SEQ_ReadRecordBuffer_LD procedure but places the // result in the array passed in the lhArray instead of directly in the // record buffer. procedure SEQ_ReadRecordBufferToArray_LD global integer liChannel integer liFile integer lhArray local integer liMax liField liLen liType local string lsValue send delete_data to lhArray get_attribute DF_FILE_NUMBER_FIELDS of liFile to liMax read channel liChannel // Set channel for liField from 1 to liMax get_attribute DF_FIELD_TYPE of liFile liField to liType if liType ne DF_OVERLAP begin if (liType=DF_BINARY or liType=DF_TEXT) begin readln liLen read_block lsValue liLen end else readln lsValue end set value of lhArray item liField to lsValue loop end_procedure // Returns true if delete was successful function SEQ_EraseFile global string lsFile returns integer if (SEQ_FileExists(lsFile)) eq SEQIT_DIRECTORY function_return 0 #IFDEF IS$WINDOWS erasefile (StringOemToAnsi(lsFile)) #ELSE erasefile lsFile #ENDIF if (SEQ_FileExists(lsFile)) eq SEQIT_NONE function_return 1 // function_return 0 end_function #IFDEF IS$WINDOWS Use wvaW32fh.pkg // Package by Wil van Antwerpen from www.vdf-guidance.com #ENDIF function SEQ_CopyFile global string lsSourceFile string lsTargetFile returns integer local integer liRval #IFDEF IS$WINDOWS move (StringOemToAnsi(lsSourceFile)) to lsSourceFile move (StringOemToAnsi(lsTargetFile)) to lsTargetFile get wvaWin32_ShCopyFile lsSourceFile lsTargetFile to liRval move (not(liRval)) to liRval #ELSE copyfile lsSourceFile to lsTargetFile if (SEQ_FileExists(lsTargetFile)) eq SEQIT_FILE move 1 to liRval else move 0 to liRval #ENDIF function_return liRval end_function // Returns true if delete was successful function SEQ_MoveFile global string lsSourceFile string lsTargetFile returns integer local integer liRval get SEQ_CopyFile lsSourceFile lsTargetFile to liRval if liRval get SEQ_EraseFile lsSourceFile to liRval function_return liRval end_function #IFDEF _UNIX_ #ELSE function SEQ_ValidDrives global returns string local integer liLen liPos lbError local string lsDrives lsDrive lsRval send delete_data move "ABCDEFGHIJKLMNOPQRSTUVWXYZ" to lsDrives move (length(lsDrives)) to liLen move "" to lsRval for liPos from 1 to liLen move (mid(lsDrives,1,liPos)) to lsDrive valid_drive lsDrive lbError ifnot lbError move (lsRval+lsDrive) to lsRval loop function_return lsRval end_function #ENDIF function SEQ_AppendFiles global string lsFile1 string lsFile2 returns integer local integer liRval liChannelOut liChannelIn liSize liIterations liRest liCount move (lowercase(lsFile1)) to lsFile1 move (lowercase(lsFile2)) to lsFile2 move 0 to liRval // Failure if lsFile1 ne lsFile2 begin // Both files exists? get SEQ_AppendOutput lsFile1 to liChannelOut if liChannelOut ge 0 begin send SEQ_WriteFile liChannelOut lsFile2 move 1 to liRval // Let's just hope it's ok //get SEQ_FileSize lsFile2 to liSize //if liSize begin // get SEQ_DirectInput ("binary:"+lsFile2) to liChannelIn // if liChannelIn ge 0 begin // move (liSize/250) to liIterations // move (liSize-(liIterations*250)) to liRest // for liCount from 1 to liIterations // read_block channel liChannelIn giSeq$Temp 250 // write channel liChannelOut giSeq$Temp // loop // read_block channel liChannelIn giSeq$Temp liRest // write channel liChannelOut giSeq$Temp // move 1 to liRval // send SEQ_CloseInput liChannelIn // end //end send SEQ_CloseOutput liChannelOut end end function_return liRval end_function // procedure SEQ_WriteHexByteStream global integer liChannel string lsHexBytes // local integer liBytes liPos liByte liByteValue // local string lsHexByte // move (length(lsHexBytes)/2) to liBytes // showln "Start SEQ_WriteHexByteStream" // decrement liBytes // for liByte from 0 to liBytes // move (liByte*2+1) to liPos // move (mid(lsHexBytes,2,liPos)) to lsHexByte // move (pos(left(lsHexByte,1),"0123456789ABCDEF")-1*16+pos(right(lsHexByte,1),"0123456789ABCDEF")-1) to liByteValue // character liByteValue to giSeq$Temp // write channel liChannel giSeq$Temp // loop // showln "End SEQ_WriteHexByteStream" // end_procedure procedure SEQ_WriteHexByteStream global integer liChannel string lsHexBytes local integer liBytes liPos liByte liByteValue liByteCount local string lsHexByte move (length(lsHexBytes)/2) to liBytes decrement liBytes move 0 to liByteCount move "" to giSeq$Temp for liByte from 0 to liBytes move (liByte*2+1) to liPos move (mid(lsHexBytes,2,liPos)) to lsHexByte move (pos(left(lsHexByte,1),"0123456789ABCDEF")-1*16+pos(right(lsHexByte,1),"0123456789ABCDEF")-1) to liByteValue append giSeq$Temp (character(liByteValue)) increment liByteCount if liByteCount eq 250 begin write channel liChannel giSeq$Temp move 0 to liByteCount move "" to giSeq$Temp end loop if liByteCount write channel liChannel giSeq$Temp end_procedure function SEQ_FileListDirectory global returns string end_function //> The cChannelAdmin class was deviced to help administrate one sequential //> channel when it is used for more than one task at the same time. //> It may be used to temporarily suspend its current connection, do //> something else and then resume where it left off. class cChannelAdmin is an cArray // in/out device ch_pos procedure construct_object integer liImg forward send construct_object liImg property integer pChannel public 0 // channel number to administrate property integer pPointer public 0 // stack pointer end_procedure procedure reset send delete_data set pPointer to 0 end_procedure procedure close_help local integer liPointer liCh liPosition lbInput local string lsDev get pPointer to liPointer decrement liPointer get pChannel to liCh get_channel_position liCh to liPosition get integer_value item (liPointer*3) to lbInput if lbInput close_input channel liCh else close_output channel liCh set value item (liPointer*3+2) to liPosition get value item (liPointer*3+1) to lsDev //send obs ("closing current activity ("+if(lbInput,"input","output")+") "+lsDev+" at position "+string(liPosition)) end_procedure procedure close_current_activity send close_help end_procedure procedure restore_activity local integer liPointer lbInput liPosition liCh local string lsDev lsValue get pPointer to liPointer decrement liPointer get pChannel to liCh get value item (liPointer*3) to lbInput get value item (liPointer*3+1) to lsDev get value item (liPointer*3+2) to liPosition if lbInput begin direct_input channel liCh lsDev if liPosition gt 0 decrement liPosition set_channel_position liCh to liPosition if liPosition gt 0 read_block channel liCh lsValue 1 end #IFDEF IS$WINDOWS // #IF (_VERSION_<_91_) else append_output channel liCh (StringOemToAnsi(lsDev)) // #ELSE // else append_output channel liCh lsDev // #ENDIF #ELSE else append_output channel liCh lsDev #ENDIF //send obs ("restoring current activity ("+if(lbInput,"input","output")+") "+lsDev+" at position "+string(liPosition)) end_procedure function sReadln returns string local string lsRval readln channel (pChannel(self)) lsRval function_return lsRval end_function //> Use this procedure to initiate a new sequential file operation. procedure direct_xput integer lbInput string lsDev local integer liPointer liChannel //send obs ("direct_xput ("+if(lbInput,"input","output")+") "+lsDev) get pPointer to liPointer get pChannel to liChannel if liPointer send close_current_activity #IFDEF IS$WINDOWS // #IF (_VERSION_<_91_) if lbInput direct_input channel liChannel (StringOemToAnsi(lsDev)) else direct_output channel liChannel (StringOemToAnsi(lsDev)) // #ELSE // if lbInput direct_input channel liChannel lsDev // else direct_output channel liChannel lsDev // #ENDIF #ELSE if lbInput direct_input channel liChannel lsDev else direct_output channel liChannel lsDev #ENDIF set array_value item (liPointer*3) to lbInput set array_value item (liPointer*3+1) to lsDev set pPointer to (liPointer+1) end_procedure //> Use procedure Close_Xput to terminate the current sequential file //> operation and restore the previous, if any. procedure close_xput local integer liPointer get pPointer to liPointer send close_help decrement liPointer set pPointer to liPointer if liPointer send restore_activity end_procedure end_class // cChannelAdmin // Returns something like
2003-08-23_175515.
function SEQ_SysTimeFileName global string lsPre string lsExt returns string
  local string lsRval
  move (lsPre+DateToString(dSysDate(),DF_DATE_MILITARY,1,"-")+"_"+replaces(":",sSysTime(),"")) to lsRval
  if (lsExt<>"") move (lsRval+"."+lsExt) to lsRval
  function_return lsRval
end_function

#COMMAND SET_CURRENT_OUTPUT_CHANNEL R .
 !A [] $10A |CI1 !1
#ENDCOMMAND
#COMMAND SET_CURRENT_INPUT_CHANNEL R .
 !A [] $10A |CI0 !1
#ENDCOMMAND

function SEQ_InputChannelLineCount global integer liChannel returns integer
  local string lsThrowAway
  get SEQ_ReadLnProbe liChannel to lsThrowAway
  function_return LineCount
end_function

function SEQ_ChannelPosToLineCount global integer liChannel integer liPos returns integer
  local integer liPushPos lbSeqEof lbSneakMode liTestPos liCount
  local string lsRval lsValue liLineCount
  get_channel_position liChannel to liPushPos

  move 0 to liCount
  set_channel_position liChannel to 0
  repeat
    readln channel liChannel lsValue
    increment liCount
    move (seqeof) to lbSeqEof
    get_channel_position liChannel to liTestPos
  until (liTestPos>=liPos or lbSeqEof<>0)
  if (liPos>liTestPos) move -1 to liCount // Signal that the position doesn't exist at all

  // Restore the state of the channel:
  move (liPushPos>0) to lbSneakMode
  if lbSneakMode decrement liPushPos
  set_channel_position liChannel to liPushPos
  if lbSneakMode read_block channel liChannel lsValue 1
  indicate seqeof as lbSeqEof ne 0
  function_return liCount
end_function

function SEQ_CurrentFolder global returns string
  local string lsValue
  GET_CURRENT_DIRECTORY to lsValue
  function_return lsValue
end_function