'30 november 2002 the stuff below Private Declare Function GetVersionEx Lib "kernel32" Alias _ "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long '19 january 2003 this and the play code results in the audio being played 'and a message "video not available cannot find vids.mjpg decompressor" 'but no video as the message suggests??? Private Declare Function mciSendString Lib "winmm.dll" Alias _ "mciSendStringA" (ByVal lpstrCommand As String, ByVal _ lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal _ hwndCallback As Long) As Long '19 january 2003 '12 December 2004a Private Declare Function mciGetErrorString Lib "winmm.dll" _ Alias "mciGetErrorStringA" _ (ByVal dwError As Long, _ ByVal lpstrBuffer As String, _ ByVal uLength As Long) As Long '12 December 2004a Private Declare Function getshortpathname Lib "kernel32" _ Alias "GetShortPathNameA" _ (ByVal lpszlongpath As String, _ ByVal lpszshortpath As String, _ ByVal cchBuffer As Long) As Long '18 June 2003 Private Type OSVERSIONINFO dwOSVersionInfoSize As Long dwMajorVersion As Long dwMinorVersion As Long dwBuildNumber As Long dwPlatformId As Long szCSDVersion As String * 128 ' Maintenance string for PSS usage End Type Private Type id3tag header As String * 3 songtitle As String * 30 artist As String * 30 album As String * 30 year As String * 4 comments As String * 30 genre As Byte End Type Private temptag As id3tag '24 June 2003 above ' dwPlatforID Constants Private Const VER_PLATFORM_WIN32s = 0 Private Const VER_PLATFORM_WIN32_WINDOWS = 1 Private Const VER_PLATFORM_WIN32_NT = 2 '-- End --' 30 november 2002 Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long Private mssg As String * 255 '26 February 2004 Private multi_prompt2 As String '04 September 2004 Private video_length As Long '26 February 2004 'Private vs As String * 30 '06 February 2004 Private vs As String * 255 '19 March 2004 Having this the wrong size was a bug of major proportions... Private last_vs As Double '24 March 2004 Private replay_pos As Double '10 April 2004 Private replay_yn As Integer '10 April 2004 Private hold_speed As Double '10 April 2004 Private command_line As String '19 September 2004 Private back_job As String '12 September 2004 Private line_fit As String '03 August 2003 Private start_point As Double '16 July 2003 Ver=1.07T Private line_start_point As Double '19 July 2003 Ver=1.07T Private temp_double As Double '19 July 2003 Ver=1.07T Private thumb_nail As String '16 July 2003 Ver=1.07T Private elapse_start As Double '13 July 2003 Private elapse_end As Double '13 July 2003 Private elapse_yn As String '13 July 2003 Private Pict_file As String 'february 09 2001 moved up to here for the "interrupt prompt" Private long_pict_file As String '22 November 2006 Private Save_file As String '15 January 2004 Private ooo As String 'february 09 2001 moved up here Private xx1 As Integer 'february 09 2001 moved up to here for the "interrupt prompt" Private yy1 As Integer Private old_line As String '25 March 2003 part of version ver=1.02b Private motion_yn '29 March 2003 part of version ver=1.04 Private special_date As String '01 April 2003 reduce the delay if "Tuesday April 1" date display done as it has delays built in ver=1.05 Private time_displayed As String '03 April 2003 indicate that time was displayed.... 'Private replace_data As String '03 April 2003 save SSS1 and replace it after date displayed Private replace_sss1 As String Private replace_sss2 As String Private replace_sss3 As String Private replace_sss4 As String Private replace_sss5 As String Private replace_sss6 As String '03 April 2003 add the replace_sss? code above Private sshortfile As String * 67 '18 june 2003 Private lresult As Long '18 june 2003 Private videoyn As String '10 february 2003 Private detailyn As String '18 November 2004 Private avi_file As String '01 february 2003 Private mpg_file As String '11 May 2003 ver=1.05 Private wav_file As String '10 June 2003 ver=1.07 Private mid_file As String '10 June 2003 ver=1.07 Private auto_exe As String '07 december 2002 Private ss_only As String '07 december 2002 Private program_info '21 december 2002 Private random_info '21 december 2002 Private stretch_info '21 december 2002 Private text_pause As Integer '05 october 2002 Private debug_photo As Integer '12 october 2002 Private show_files As String '24 december 2002 Private show_files_yn As Integer '24 december 2002 Private do_tab As Integer '05 october 2002 Private search_str As String '26 august 2002 Private rand As Integer '18 august 2002 Private rand1 As Integer '23 March 2004 Private rand_cnt1 As Double '23 March 2004 Private rand_no1 As Double '23 March 2004 Private rand_cnt As Double '18 august 2002 Private rand_no As Double '18 august 2002 Private diryes As String 'february 18 2002 Private Mergem As String 'february 24 2002 Private temptemp As String 'february 18 2002 Private tempdata As String '31 March 2003 Private eofsw As String '26 November 2004 Private fract_time As Double 'january 23 2002 Private check_time As Double 'january 23 2002 Private slomo As Integer '08 January 2004 Private slomo_start As Double '08 january 2004 Private motion_in As Double '01 March 2004 Private motion_out As Double '01 March 2004 Private slomo_in As Double '08 January 2004 Private slomo_out As Double '08 January 2004 Private pad_time As Double '21 March 2004 Private slomo_seg As Double '08 January 2004 Private inter_in As Double '22 February 2004 Private inter_out As Double '22 February 2004 Private sscreen_saver As String 'may 06 2001 Private sscreen_saver_ww As String '28 april 2002 Private os_ver As String '30 november 2002 Private os_num As String '01 december 2002 Private offset1 As Integer 'april 06 2001 Private offset2 As Integer 'april 06 2001 Private ppoffset1 As Integer '27 july 2002 Private ppoffset2 As Integer '27 july 2002 Private dblStart As Double 'used for elapsed time Private dblEnd As Double ' " " " " Private dbltime1 As Double Private dbltime2 As Double Private prompt2 As String 'march 01 2001 Private interrupt_prompt2 '20 November 2004 'see the 15 December 2004 minor changes so that "Y" for last of file can be defaulted in and out.. Private SAVE_ttt As String 'march 01 2001 controls defaults on start and default out after first entry Private inin As String 'march 01 2001 Private SSS1 As String 'march 01 2001 Private prev_option As String 'february 25 2001 Private hh_cnt As Long 'april 22 2001 Private xtemp As String 'november 12 2000 Private ooopen As String 'september 02 2001 Private dsp_cnt As Long 'may 09 2001 count of total pictures displayed Private delete_file As String 'june 30 2001 'insert the new globals right here october 28 2001 Private strBuffer As String Private lngBufSize As Long Private lngStatus As Long Private lpBuff As String * 25 Private ret As Long, UserName As String Private strRootPathName As String Private lngSectorsPerCluster As Long Private lngBytesPerSector As Long Private lngNumberOfFreeClusters As Long Private lngTotalNumberOfClusters As Long Private strDrive As String Private strMessage As String Private lngTotalBytes As Long Private lngFreeBytes As Long Private hilite_hh As String 'april 22 2001 Private hilite_cnt As Integer 'april 22 2001 Private fs, f1, s 'april 11 2001 Private dirdates As String 'april 11 2001 Private indates As String 'april 11 2001 Private append_start1 As String 'april 10 2001 Private append_end1 As String 'april 10 2001 Private prev_ttt As String 'april 10 2001 Private skipyesno As String 'june 09 2001 Private old_pict As String 'april 08 2001 Private newname As String 'april 01 2001 Private filereason As String 'april 01 2001 Private savepath As String 'april 01 2001 Private leaddidg As String 'april 01 2001 Private thedir As String 'april 01 2001 Private indir As String 'april 01 2001 Private outdir As String 'april 01 2001 Private filetype As String 'april 01 2001 Private dirtype As String 'february 23 2002 Private minsize As Double 'april 01 2001 08 junt 2003 Private maxsize As Double 'april 01 2001 08 june 2003 change from long to double Private autobuild As String 'april 01 2001 Private inplace As String 'april 01 2001 Private endstuff As String 'january 21 2001 Private s1_imbed As String 'january 19 2001 Private s2_imbed As String 'january 19 2001 Private s3_imbed As String 'january 19 2001 Private s4_imbed As String '23 june 2002 Private s5_imbed As String '23 june 2002 Private s6_imbed As String '23 june 2002 Private imbedded As String 'january 19 2001 Private new_len As Integer 'january 18 2001 Private array_ooo(55) As String 'january 18 2001 Private array_aaa(55) As String 'january 18 2001 Private match_flag As String 'january 18 2001 Private array_pos As Integer 'january 18 2001 Private array_prt As Integer 'january 18 2001 Private data_ooo As String 'january 15 2001 Private data_aaa As String 'january 15 2001 Private over_lap As Integer 'january 10 2001 Private crop_len As Integer 'january 09 2001 Private wrap_cnt As Long 'january 07 2001 Private mess_cnt As Long 'january 02 2001 Private tot_s1 As Long 'january 01 2001 Private tot_s2 As Long 'january 01 2001 Private tot_s3 As Long 'january 01 2001 Private tot_s4 As Long '23 june 2002 Private tot_s5 As Long '23 june 2002 Private tot_s6 As Long '23 june 2002 Private context_win As Integer 'january 01 2001 Private page_prompt As String 'december 31 2000 Private dateskip As String 'december 12 2000 Private boundarycnt As Integer 'december 11 2000 Private boundarystr As String 'december 11 2000 Private mbxyes As String 'december 17 2000 Private mbxi As Integer 'december 17 2000 Private emailsea As String 'december 11 2000 Private iimport As String 'december 24 2000 Private showpos As String 'december 6 2000 Private showasc As String 'december 11 2000 ' showpos = "Y" 'december 6 2000 **keep** very handy for testing line wraps only Private uppercase As String 'december 8 2000 Private posstring As String 'december 6 2000 Private crlf As String 'december 2 2000 Private changes As String 'december 2 2000 Private save_line As String 'to display error line numbers 'usefull for debug Private extract_yes As String 'november 12 2000 Private skip_info As String 'november 14 2000 Private encript As String 'november 20 2000 Private hilite_this As String 'november 8 2000 Private OutFile As Integer Private BatchFile As Integer '27 October 2004 Private FileFile As Integer 'march 20/00 edit files list Private CtrlFile As Integer '19 November 2004 Private NewFile As Integer 'january 29 2002 Private ResultFile As Integer '08 November 2004 Private ExtFile 'november 12 2000 Private FileExt As String 'november 17 2000 Private case_yes 'november 13 2000 Private search_prompt As String Private ampm As String Private hhour As String Private mminute As String Private ssecond As String Private ggg As String Private hhhour As Long Private mmminute As Long Private sssecond As Long Private chhour As Long Private cmminute As Long Private control_file As String 'november 03 2000 Private control_files(10) As String '23 November 2004 Private xxx_found As String 'november 03 2000 Private pp_entered As String 'november 6 2000 Private cssecond As Long Private freeze_sec As Double '01 October 2003 Private adjust_sec As Double '29 September 2003 Private delay_sec As Double Private new_delay_sec As Double '05 March 2004 Private line_delay_sec As Double '19 July 2003 Ver=1.07T Private Line_freeze_sec As Double '24 September 2003 Private line_speed As Double '16 November 2003 Private hold_sec As Double 'february 08 2002 Private photo_copy As String 'march 17 2001 Private copy_photo As String 'march 17 2001 Private photo_dir As String 'march 17 2001 ie c:\search\tempfold\ Private photo_file As String 'march 17 2001 ie pict Private photo_cnt As Integer 'march 17 2001 sequential count of photo's Private temp_sec As Integer 'march 14 2001 Private temp_cnt As Double '08 July 2003 Private temp_cnt1 As Double '12 April 2004 Private screen_capture As String 'march 15 2001 Private tot_print As Integer Private ss_search As String 'may 06 2001 Dim sscreen_saver As String '12 December 2004a Private result1 As Long '12 December 2004a Private errormsg1 As Integer '12 December 2004a Private returnstring1 As String * 1024 '12 December 2004a Private errorstring1 As String * 1024 '12 December 2004a '12 December 2004a Private line_len As Integer Private entered_notes As String Private in_str As String Private out_str As String Private f As Integer Private FFF As String Private TheFile As String Private LastFile As String Private AllFiles(20) As String Private vvversion As String Private AllSearch(20) As String Private Cmd(100) As String 'april 01 2001 made cript1 400 for the folders used in gf option Private cript1(20000) As String 'november 18 2000 ' Private cript2(100) As String 'november 18 2000 ' Private cript3(100) As Integer 'november 20 2000 Private cript2(20000) As String '28 October 2004 big enough for my program... Private cript3(20000) As Integer '28 October 2004 ' Private criptcnt As Integer 'november 18 2000 Private criptcnt As Long '28 October 2004 above was 10000 too Private TheSearch As String Private FileFound As Integer Private Clip_data As String Private Last_match As String 'input line where match found Private last_pict '28 february 2003 Private noshow(10) As String Private screensave(10) As String Private screencount As Integer Private nocount As Integer Private Line_Search Private Picture_Search As String Private Previous_line_save As String Private Previous_line As String Private Next_line_save As String Private Next_line As String Private This_line As String Private String_Position As Integer ' Dim Pict_file As String 'moved up for "interrupt prompt" february 09 2001 Private disp_file As String Private long_line As String 'identify long line Private II As Integer Private EE As Double '11 december 2002 Private III As Integer Private JJ As Integer Private tt As Integer Private ttt1 As Integer Private ddd As Integer Private Enter_Count As Integer Private img_ctrl As String 'february 21 2001 Private stretch_img As String 'march 31 2001 Private auto_redraw As String 'november 10 2001 Private ttt As String Private p2p2 As String '10 august 2002 Private tt1 As String 'testing only Private Test1_str As String 'Testing only Private Test2_str As String 'november 23 2001 Private prompt1 As String ' Dim prompt2 As String Private prompt3 As String ' Dim SAVE_ttt As String Private qqq As String ' Dim SSS1 As String what the hey why commented out????? ***vip*** it is strange too Private SSS2 As String Private SSS3 As String Private SSS4 As String '09 june 2002 Private SSS5 As String Private SSS6 As String Private sep As String ' Dim inin As String Private KEEPS1 As String Private KEEPS2 As String Private KEEPS3 As String Private KEEPS4 As String '09 june 2002 Private KEEPS5 As String Private KEEPS6 As String Private hi_lites As String 'flash display Private SAVE_KEEPS1 As String 'june 26/99 Private SAVE_KEEPS2 As String Private SAVE_KEEPS3 As String Private SAVE_KEEPS4 As String '09 june 2002 Private SAVE_KEEPS5 As String Private SAVE_KEEPS6 As String Private Context As String 'june 26/99 Private aaa As String ' Dim ooo As String 'hold the original upper/lower case Private ccc As String 'aug 08/99 Private xxx As String 'january 19 2001 checking for imbedded spaces in search string only Private Context_text(40) As String 'aug 08/99 Private previous_picture(100) As Long Private pp As Long Private last_pp As Long 'may 10 2001 Private skip_pp As Long 'may 10 2001 Private previous_count As Long Private ddemo As String Private date_check As String Private today_date As String Private visual_impared As String Private Context_cnt As Integer 'aug 08/99 Private Context_lines As Integer Private Clear_Context_lines As Integer '18 March 2003 ver=1.01 Private zzz_chrs As Long Private zzz_len As Integer Private cnt As Long Private SSS As String Private SAVE_SSS As String Private SAVE_SRCH As String Private MAX_CNT As Long ' Dim back_cnt As Long Private bbb As Long Private tot_cnt As Long Private end_cnt As Integer Private tot_disp As Long Private time_cnt As Long Private time_num As Long Private lll As String Private tttpos As Integer Private i As Long Private loop_cnt As Long Private loop_inc As Long Private j As Long Private AltColor As Integer Private Hold_Fore As Integer '27 July 2003 Private Def_Fore As Integer Private Set_Fore As Integer Private temp_fore As Integer 'november 9 2000 Private new1 As String 'november 9 2000 Private new2 As String 'november 9 2000 Private new3 As String 'november 9 2000 Private new4 As String '09 june 2002 Private new5 As String '09 june 2002 Private new6 As String '09 june 2002 Private mult1 As String 'november 21 2000 Private mult2 As String 'november 21 2000 Private mult3 As String 'november 21 2000 Private mult4 As String '09 june 2002 Private mult5 As String '09 june 2002 Private mult6 As String '09 june 2002 Private line_pos As String 'november 22 2000 Private line_match As String 'november 21 2000 Private keep_aaa As String 'november 9 2000 Private keep_ooo As String 'november 9 2000 Private temp1 As Long Private temp11 As Long 'march 14 2001 Private temp2 As Long Private temp3 As Integer Private temp4 As Long 'november 9 2000 Private temps As String Private testprompt As String 'january 24 2001 Private ytemp As String 'december 11 2000 Private tempss As String Private ppaste As String Private gpaste As String Private play_speed As Long '29 October 2003 Private save_play_speed As Long '16 November 2003 Private date_displayed As String 'save for later search Private printed_cnt As Long 'may 10/00 Private displayed_cnt As Long Private printed As String 'october 28 2001 Private hold_zzz As Long '21 September 2004 Private yyy_cnt As Long '28 October 2004 Private zzz_cnt As Long 'february 19 2001 display in interrupt prompt 'if items arn't declared in general they arn't available to the other subroutines. ' Private Sub Command1_Click() ' MsgBox xx1 'may 06 2001 allow for an interrupt on the screen saver to switch into ' the p1 search and thus be able to do a "P" for previous picture Def_Fore = Hold_Fore 'reset color 27 July 2003 ' Test2_str = InputBox("27 July 2003 testing ", "testing doug ", , xx1 - 5000, yy1 - 5000) ' '23 February 2004 If sscreen_saver = "Y" Then '20 November 2004 with the code here the interrupt didnot work so put it back.. good test though '20 November 2004 If sscreen_saver = "Y" And mpg_file <> "YES" And interrupt_prompt2 <> "WW" Then ' frmproj2.Caption = "interrupt click " + ttt + "*" + Test1_str + "*" + prompt2 '20 November 2004 interrupt_prompt2 = "WW" '21 November 2004 If sscreen_saver = "Y" And mpg_file <> "YES" Then ttt = "P" Test1_str = "P1" sscreen_saver = "N" ' Test2_str = InputBox("delay_sec test ", CStr(new_delay_sec) + "*" + CStr(delay_sec), , xx1 - 5000, yy1 - 5000) ' ' frmproj2.Caption = "delay_sec test " + CStr(new_delay_sec) + "*" + CStr(delay_sec) '20 November 2004 new_delay_sec = delay_sec '23 November 2004 allow it to back up faster delay_sec = 0 '23 November 2004 delay_sec gets reset each new photo '20 November 2004 SSS1 = "PHOTO" 'may 28 2001 allows the "P" to show all previous 'pictures after the screen saver is interrupted. 'it just looks at the last picture saved. prompt2 = "P1" GoTo little_lower '21 November 2004 End If 'may 06 2001 If mpg_file = "YES" Then '22 February 2004 '02 March 2004 check the status here before pause DoEvents '02 March 2004 i = mciSendString("status video1 mode", mssg, 255, 0) '02 March 2004 DoEvents '05 March 2004 frmproj2.Caption = " status_a is " + Trim(mssg) '05 March 2004 DoEvents '02 March 2004 If Left(UCase(mssg), 6) = "PAUSED" Then i = mciSendString("resume video1", 0&, 0, 0) DoEvents mssg = "PLAYING" '02 March 2004 End If '02 March 2004 If Left(UCase(mssg), 7) = "PLAYING" Then i = mciSendString("pause video1", 0&, 0, 0) '02 March 2004 DoEvents Else 'Test2_str = InputBox("video status= " + Trim(mssg), "testing doug ", , xx1 - 5000, yy1 - 5000) '02 March 2004 ' Print bel '02 March 2004 testing only ' frmproj2.Caption = " status is " + Trim(mssg) '02 March 2004 End If '02 March 2004 '02 march 2004 i = mciSendString("pause video1", 0&, 0, 0) '22 February 2004 inter_in = Timer '22 February 2004 get the time we delay here. DoEvents '22 February 2004 i = mciSendString("status video1 position", vs, 255, 0) '22 February 2004 tempdata = " Pos=" + CStr(Val(vs)) + " (of) " + CStr(video_length) '26 February 2004 DoEvents '23 February 2004 '26 February 2004 frmproj2.Caption = LCase(temptemp) + " pos=" + Trim(vs) '22 February 2004 frmproj2.Caption = LCase(temptemp) + tempdata '26 February 2004 DoEvents '22 February 2004 End If '22 February 2004 If mpg_file = "YES" Then '24 February 2004 If replay_yn = True Then '10 April 2004 play_speed = hold_speed '10 April 2004 replay_yn = False '10 April 2004 End If '10 April 2004 in case 2 interrupts in a row... '27 August 2004 Test2_str = InputBox("Enter . to rewind video " + vbCrLf + Pict_file + vbCrLf + ooo, "Interrupt Prompt # " + CStr(dsp_cnt), , xx1, yy1) '24 February 2004 '02 September 2004 If thumb_nail = "YES" Then GoTo little_lower '29 August 2004 'allow for thumbnail of video to pause first off maybe even do the same for mp3 (a pause is not bad here?) Test2_str = "A" '02 September 2004 If thumb_nail = "YES" And InStr(UCase(Line_Search), "MP3") <> 0 Then GoTo little_lower '29 August 2004 '02 September 2004 Test2_str = InputBox("Enter . to rewind video (aa) for all" + CStr(video_length) + vbCrLf + Pict_file + vbCrLf + ooo, "Interrupt Prompt # " + CStr(dsp_cnt), , xx1, yy1) '24 February 2004 Test2_str = InputBox("E or X to Stop -- Enter . to rewind video (a) for all" + CStr(video_length) + vbCrLf + Pict_file + vbCrLf + ooo, "Interrupt Prompt # 0 " + CStr(dsp_cnt), , xx1, yy1) '24 February 2004 Test2_str = Trim(UCase(Test2_str)) '12 December 2004 If Test2_str = "E" Or Test2_str = "X" Then Unload Me '12 December 2004 Set frmproj2 = Nothing Stop '12 december 2004 ' Resume End_32000 '12 December 2004 this line is not part of this subroutine... End If '12 December 2004 allow for exit too at interrupt... little_lower: '29 August 2004 '16 August 2004 frmproj2.Caption = LCase(temptemp) + " (Replay by Spectate Swamp)" '26 February 2004 frmproj2.Caption = LCase(temptemp) + " (Replay by Spectate Swamp)length=" + CStr(video_length / 1000) + " seconds" '16 August 2004 '02 September 2004 If thumb_nail = "YES" Then If thumb_nail = "YES" And UCase(Test2_str) = "A" Then ' If UCase(Test2_str) = "AA" Then ' thumb_nail = "NO" Test2_str = "" ' line_delay_sec = video_length / 1000 ' delay_sec = line_delay_sec ' new_delay_sec = delay_sec i = mciSendString("stop video1", 0&, 0, 0) DoEvents ' line_start_point = 10 ' i = mciSendString("play video1 from " + CStr(10) + " wait", 0&, 0&, 0&) '29 August 2004 this works better last_vs = video_length - 100 '29 August 2004 These 3 lines replace the WAIT call above works WELL slomo = True '29 August 2004 i = mciSendString("play video1 from " + CStr(10), 0&, 0&, 0&) ' Test2_str = InputBox("When done hit enter " + vbCrLf + Pict_file + vbCrLf + ooo, "Waiting till end prompt # ", , xx1 - 5000, yy1 - 5000) 'february 09 2001 ' i = mciSendString("stop video1", 0&, 0, 0) ' inter_in = Timer ' GoSub line_30300 GoTo down_abit End If '27 August 2004 DoEvents '26 February 2004 Else Test2_str = InputBox("Enter to continue x or e to exit " + vbCrLf + Pict_file + vbCrLf + ooo, "Interrupt Prompt # " + CStr(dsp_cnt), , xx1 - 5000, yy1 - 5000) 'february 09 2001 End If ' ShowCursor = True '29 november 2002 Cmd(45) = "" '07 december 2002 allow for other drives after interrupt.. Test2_str = UCase(Test2_str) '06 october 2002 '22 February 2004 on video play Pause, Show Position, Resume after adding in paused time. If mpg_file = "YES" Then '22 February 2004 DoEvents '22 February 2004 '26 April 2004 try saving the results here ' If Left(Test2_str, 1) = "F" Then ' i = mciSendString("save video2 c:\search\outmpg.mpg", 0&, 0, 0) ' new_delay_sec = 5.5 ' GoSub line_30300 ' Close video2 ' For EE = 1 To 10000000 ' DoEvents ' Next EE 'give it some time ' End If 'need more info on the mcisendstring and how to record mpg files??? '26 April 2004 '24 february 2004 back up the video here if .... entered '23 April 2004 allow for multiple ... or '''' to go back and ahead '23 April 2004 If Left(Test2_str, 1) = "." Then If Left(Test2_str, 1) = "." Or Left(Test2_str, 1) = Chr(39) Then i = mciSendString("stop video1", 0&, 0, 0) III = Len(Test2_str) '23 April 2004 If Left(Test2_str, 1) = Chr(39) Then III = III * -1 '23 April 2004 DoEvents '10 April 2004 allow for replay at a slower speed dictated by a cmd(?) value... replay_yn = False '10 April 2004 i = mciSendString("status video1 position", vs, 255, 0) '10 April 2004 temp3 = InStr(vs, Chr$(0)) '10 April 2004 temp11 = Val(Left(vs, temp3 - 1)) '10 April 2004 '23 April 2004 If Val(Cmd(66)) > 1 And Val(Cmd(66)) < 1000 Then '23 April 2004 do not change speed if moving ahead in file If Val(Cmd(66)) > 1 And Val(Cmd(66)) < 1000 And Left(Test2_str, 1) <> Chr(39) Then hold_speed = play_speed '10 April 2004 play_speed = Val(Cmd(66)) '10 April 2004 replay_yn = True '10 April 2004 replay_pos = temp11 '10 April 2004 slomo = True '10 April 2004 if full speed to slow speed this needed End If '10 April 2004 '23 April 2004 i = mciSendString("play video1 from " + CStr(Val(vs) - (Val(Cmd(27)) * 1000)), 0&, 0&, 0&) i = mciSendString("play video1 from " + CStr(Val(vs) - (Val(Cmd(27)) * 1000) * III), 0&, 0&, 0&) last_vs = Val(vs) - Val(Cmd(27) * 1000) '06 April 2004 without this the replay is at fast speed 'might be handy to have this as an option maybee DoEvents ' temptemp = InputBox("04 April 2004 test ", "Test continue " + CStr(dsp_cnt), , xx1 - 5000, yy1 - 5000) Test2_str = "" GoTo down_abit End If '24 February 2004 i = mciSendString("resume video1", 0&, 0, 0) DoEvents '09 March 2004 down_abit: '24 February 2004 inter_out = Timer '22 February 2004 add the delay here back in. If slomo = False Then fract_time = fract_time + inter_out - inter_in '22 February 2004 End If End If '22 February 2004 '22 February 2004 '06 January 2005 allow for an entry to continue here '06 January 2005 If text_pause And Test2_str <> "C" Then If text_pause And (Test2_str = "X" Or Test2_str = "E") Then text_pause = 0 '05 october 2002 "C" allow for continue of auto display inin = "" End If If UCase(Test2_str) = "A" Then prompt2 = "C" 'march 01 2001 SAVE_ttt = "C" inin = "A" SSS1 = "A" 'march 01 2001 End If '13 March 2004 If UCase(Test2_str) <> "X" And UCase(Test2_str) <> "E" Then GoTo line_15 'February 09 2001 If mpg_file = "YES" Then '04 April 2004 i = mciSendString("close all", 0&, 0, 0) DoEvents '22 March 2004 tt1 = InputBox("testing only closing down", , , 4400, 4500) 'TESTING ONLY 13 March 2004 End If '11 March 2004 '04 April 2004 Unload Me '04 April 2004 Set frmproj2 = Nothing 'sdistuff '04 April 2004 Set colReminderPages = Nothing 'release memory?? ' Set sear1 = Nothing 'mdistuff '04 April 2004 take this out End 'feburary 5 2001 line_15: ' temptemp = InputBox(" 04 April 2004 doug " + SSS1, "testing Prompt ", , xx1 - offset1, yy1 - offset2) End Sub Private Sub Form_Click() 'this is activated in the flash mode when mouse button is hit march 02 2001 Test1_str = InputBox("in form_click" + vbCrLf + Pict_file + vbCrLf + ooo, "Interrupt Prompt " + CStr(zzz_cnt), , xx1 - offset1, yy1 - offset2) 'february 09 2001 'march 02 2001 'seems not to do anything when in sdi mode ??? 'ie holding down the left mouse does nothing only works in mdi mode End Sub Private Sub Form_Deactivate() '03 July 2003 testing to clean up the unload process (just needed to add these two routines?????) 'using the X for closing the form down check this bit out End Sub Private Sub Form_Initialize() 'system compoenents: Use 'form does almost everything 'command button used for esc out of screen saver ' set cancel property to true and place off the screen 'text block (removed) allows key entry to interrupt screen saver (placed off the screen) 'image control allows for p2 option with stretch set to true for full screen size 'when compiling for the millennium set BorderStyle to 2 from 0 todo **vip** 'Load proj2 ' Always set the working directory to the directory containing the application. ' do the startup steps below ' tt1 = InputBox("doug startup test1 " + App.Path, "titlename", "Default", 4400, 4500) 'TESTING ONLY ChDir App.Path 'december 1 2000 'same as "set default" on the vax Cls 'november 7 2000 'january 31 2001 'App.StartLogging "douglog.txt", 0 'july 04 2001 see other test of startlogging 'the above did create a file so this is a start july 04 2001 'january 31 2001 If App.PrevInstance Then MsgBox "Already running!", _ vbOKOnly, App.EXEName & _ "Warning!" End End If offset1 = 4500 'april 06 2001 offset2 = 5000 'april 06 2001 program_info = "Spectate Swamp Desktop Search" '21 december 2002 (maybe Spectate Swamp) App.Title = program_info 'january 31 2001 frmproj2.Caption = program_info + " (stonedan@telusplanet.net)" '25 november 2002 frmproj2.Show 'sdistuff ' sear1.Show 'mdistuff 'equivalent of CVT$% is Asc below ' tt1 = InputBox("Form_Initialize " + CStr(Asc("a")) + Chr(97), , , 4400, 4500) 'TESTING ONLY ' tt1 = InputBox("Form_Initialize " + App.Path, "titlename", "Default", 4400, 4500) 'TESTING ONLY ' Cls 'february 05 2001 comment out the next line ' Call text2_Change ' february 01 2001 Call text2_Chg 'february 05 2001 'test the logging stuff some time later.... ' Call App.StartLogging(App.Path + "\logfile.txt", 2) 'january 30 2001 ' Call App.LogEvent("starting", 4) 'january 30 2001 ' Call App.LogEvent(txtLog, vbLogEventTypeInformation) 'january 30 2001 End Sub Private Sub text2_Chg() 'Private Sub text2_Change 'february 01 2001 'savior version 1.0 'all unpaid copies carry a curse ' be warned ' ' ** set auto_redraw to "false" ' much much faster than true ' for Keep-it super-search anyway ' set windowstate to 2 for maximized 'to get rid of the mini text block set the ' left element from 402 to 600 'in the properties window for the for set the following 'height to 9000 'width to 12000 '========================================================================== 'january 31 2001 see function above GetComputerName lngBufSize = 255 strBuffer = String$(lngBufSize, " ") lngStatus = GetComputerName(strBuffer, lngBufSize) strBuffer = Left(strBuffer, lngBufSize) If lngStatus <> 0 Then 'commented out january 31 2001 below ' MsgBox ("Computer name is: " & Left(strBuffer, lngBufSize)) End If '========================================================================== 'Code: see function above GetUserName ' Main routine to Dimension variables, retrieve user name ' and display answer ' Dimension variables ' Get the user name minus any trailing spaces found in the name. ret = GetUserName(lpBuff, 25) UserName = Left(lpBuff, InStr(lpBuff, Chr(0)) - 1) ' Display the User Name ' MsgBox UserName 'commeted out january 31 2001 '========================================================================== '========================================================================== 'see call to GetDiskFreeSpace function above january 31 2001 'Code: strDrive = "C:\" 'drive letter 'note to vb6 comment out the following code as it gets errors overflow etc... 'january 27 2002 comment it out as I am not using it anyway ' If GetDiskFreeSpace(strDrive, lngSectorsPerCluster, lngBytesPerSector, lngNumberOfFreeClusters, lngTotalNumberOfClusters) = 0 Then ' strMessage = strMessage & vbCrLf & "An error occurred." ' Else ' strMessage = strMessage & vbCrLf & "Sectors Per Cluster: " & Format$(lngSectorsPerCluster) ' strMessage = strMessage & vbCrLf & "Bytes Per Sector: " & Format$(lngBytesPerSector) ' strMessage = strMessage & vbCrLf & "Free Clusters: " & Format$(lngNumberOfFreeClusters) ' strMessage = strMessage & vbCrLf & "Total Clusters: " & Format$(lngTotalNumberOfClusters) ' lngTotalBytes = lngTotalNumberOfClusters * lngSectorsPerCluster * lngBytesPerSector ' strMessage = strMessage & vbCrLf & "Total Bytes: " & Format$(lngTotalBytes) ' lngFreeBytes = lngNumberOfFreeClusters * lngSectorsPerCluster * lngBytesPerSector ' strMessage = strMessage & vbCrLf & "Bytes Free: " & Format$(lngFreeBytes) ' strMessage = strMessage & vbCrLf & "Percent Used: " & Format$(1 - (lngFreeBytes / lngTotalBytes), "0.00%") ' End If If Left(strBuffer, lngBufSize) = "OEMCOMPUTER" Then ' MsgBox (strMessage) End If 'january 31 2001 only show it if it my laptop strMessage = strMessage + vbCrLf + "User name=" + UserName + vbCrLf + "Computer name=" + strBuffer & vbCrLf '30 november 2002 the stuff below for computer version Dim tOSVer As OSVERSIONINFO ' First set length of OSVERSIONINFO ' structure size tOSVer.dwOSVersionInfoSize = Len(tOSVer) ' Get version information GetVersionEx tOSVer ' Determine OS type With tOSVer Select Case .dwPlatformId Case VER_PLATFORM_WIN32_NT ' This is an NT version (NT/2000) ' If dwMajorVersion >= 5 then ' the OS is Win2000 If .dwMajorVersion >= 5 Then FFF = "Windows 2000" Else FFF = "Windows NT" End If Case Else ' Test2_str = InputBox("testing versioninfo " + CStr(.dwPlatformId) + " " + FFF, " " + CStr(zzz_cnt), , xx1, yy1) 'february 09 2001 ' This is Windows 95/98/ME If .dwMajorVersion >= 5 Then FFF = "Windows ME" ElseIf .dwMajorVersion = 4 And .dwMinorVersion > 0 Then FFF = "Windows 98" Else FFF = "Windows 95" End If End Select ' Check for service pack FFF = FFF & " " & Left(.szCSDVersion, _ InStr(1, .szCSDVersion, Chr$(0))) os_ver = FFF '30 november 2002 I use this variable later maybe ' Get OS version ttt = "Version= " & .dwMajorVersion & "." & _ .dwMinorVersion & "." & .dwBuildNumber os_num = .dwMajorVersion & .dwPlatformId '01 december 2002 use to determine 8, 10 or 43, 44 End With strMessage = strMessage + ttt + " len=" + CStr(Len(os_ver)) + vbCrLf strMessage = strMessage + "OS=" + os_ver 'I used this for display ' tt1 = InputBox(strMessage, "testing", , 8000, 5000) '30 november 2002 '========================================================================== On Error GoTo Errors_31000 save_line = "000" 'for error handling ' Static xx1 As Integer ' Static yy1 As Integer '0 = black '1 = dark blue '2 = green '3 = aqua '4 = brown '5 = purple '6 = lime/green/brown? '7 = grey '8 = dark grey '9 = blue bright '10 = lime green bright '11 = pale blue '12 = red '13 = purple light pink '14 = yellow '15 = white 'test some code here in this area 'temps = CallByName(wordpad, "c:\search\notes.txt", , "c:\search\notes.txt") line_20: save_line = "20" '04 November 2003 see cmd(61) for play_speed play_speed = 1000 '30 October set to normal speed SAVE_ttt = "in" 'default to "c" if comming in 'april 14/00 start_point = 0 '16 July 2003 Ver=1.07T start_point = 10 '09 September 2003 service pack 1 needs this ???? line_start_point = 0 '19 July 2003 Ver=1.07T line_start_point = 10 '11 March 2007 search_prompt = "in" 'april 24/00 visual_impared = "YES" 'to set up control.txt visual_impared = "NO" 'settings for ron windels date_check = "NO" 'do not do date check logic ' date_check = "YES" 'do date check logic ddemo = "YES" ddemo = "NO" 'set to "YES" if demo "NO" if full system If UCase(App.EXEName) = "DEMO" Then ddemo = "YES" '08 August 2003 ' control_file = "c:\control.txt" 'november 03 2000 control_file = "control.txt" 'december 03 2000 GoSub Control_28000 'assign font color etc 20/04/00 ' Picture1.Left = 0 'june 17/99 ' Picture1.Top = 0 save_line = "25" OutFile = FreeFile KEEPS1 = "" KEEPS2 = "" KEEPS3 = "" KEEPS4 = "" '09 june 2002 KEEPS5 = "" KEEPS6 = "" 'tell them where this program comes from SSS = Format(Now, "ddddd ttttt") 'todays date temp1 = InStr(2, SSS, "/1/") vvversion = "Version September 1/00" vvversion = "Version September 5/00" 'extended control.txt to 40 from 20 vvversion = "Version September 8/00" 'line wrap control.txt element 21 to 40 from 82 etc vvversion = "Version September 10/00" 'context lines 10 or 5 etc 'added the B for back option vvversion = "Version October 4/00" 'noshow and others added vvversion = "Version October 9/00" 'p for previous picture allowed vvversion = "Version October 13/00" 'restricted demo version and date check back in vvversion = "Version October 19/00" 'don't load the clipboard and make sure search selection has at least 3 of the same chrs vvversion = "Version October 21/00" 'Quickie search if Q entered no context display and skip if no match vvversion = "version October 23/00" 'quickie fixes and security completed next audio vvversion = "Version October 26/00" 'no start character required and unload form3 at end automatically no close required vvversion = "Version October 27/00" 'allow for "A" for all at next photo prompt vvversion = "Version October 29/00" 'finish with line wrap fixes context data and match line fixed finally vvversion = "Version November 3/00" 'allow for ccc to select control1.txt for larger fonts etc 'allow for auto setting of c and p1 depending if xxx. found in first 10 lines 'allow for any file selection to reset as if first time in for defaults etc vvversion = "Version November 12/00" 'allow for extract of printed data to file vvversion = "Version November 13/00" 'make rrr case sensitive and allow or name as of files vvversion = "Version November 14/00" 'allow for "F" at do you want to continue 'as well change the xxx to be entered at the option entry vvversion = "Version November 22/00" 'changes to allow for multiples on a line to be displayed ie telusplanet.net ' both the net's will show on a "net" search vvversion = "Version November 29/00" 'minor bug fix to the rrr routine vvversion = "Version December 2/00" 'allow for QQQ at the option level same as RRR but 'used to fix From: Subject: in mail messages removes crlf at end 'and pastes the next line on to the end Date: Organization: To: done too vvversion = "Version December 3/00" 'use default directory App.Path wherever the program exists look for control.txt etc. vvversion = "Version December 5/00" 'do display of multiples on a line minor change vvversion = "Version December 6/00" 'allow for LL linelength to be input and for showpos options 'the showpos shows the line length at the wrap just in case more problems crop up vvversion = "Version December 7/00" 'allow for Cmd(33) to be search default ie "D" for me and use the inputbox prompt field 'do the changes to get rid of the max and min border set borderstyle to 0 from 2 and max and min to false vvversion = "Version December 8/00" 'change option S to work like option Q quickie search but not to be case sensitive. it takes 2 as long as Q not 4 times as long now 'allow for X or E to exit if element 30 set to "N" and make files case insensitive? vvversion = "Version December 10/00" 'reget defaults once file is selected a second time vvversion = "Version December 11/00" 'Allow for showasc at the option level to show the last 4 characters ascii value. 'Allow for email prompt at the option level to read thru and display email records without the junk vvversion = "Version December 20/00" 'minor changes to fix the netscape extract etc vvversion = "Version December 22/00" 'allow for "A" for all when using the "Q" search vvversion = "Version December 23/00" 'a few fix ups for the imported outlook express into netscape 6.0 vvversion = "Version December 24/00" 'new option of "IMPORT" if the file is email and import entered vvversion = "Version December 27/00" 'if CH was selected the option prompt was getting in the way the second time around 'the AppActivate fixed the problem though vvversion = "Version December 28/00" 'did some clean up on the search selection no longer allow the number of characters to select previous searches 'minor fix to the "." at the b for back prompt cleared SSS2 and SSS3 etc vvversion = "Version December 31/00" 'minor fix re short lines with odd characters and boundarystr reset to ""2 'new option "R" extract skip page_prompt AND set to "Q" search 'as long as everything is being extracted then don't stop at number of lines per screen Cmd(1) 'new option "D" extract skip page_prompt and set to "C" with MAX_CNT = 5 Context_lines = 2 vvversion = "Version January 01/01" 'new option "T" just like D and R above 'use element Cmd(34) for the context_win default to 3 if not there vvversion = "Version January 02/01" 'final counts for tot_s1 tot_s2 tot_s3 now tested and seem to work ok vvversion = "Version January 03/01" 'noshow for text display will replace the string with **** as censorship 'the 03a version changes made to allow elements to be hilited after the "A" is entered. 'the very first one on a line was what was happening and this was the fix vvversion = "Version January 04/01" 'fix for multiple no-show elements and a 04a fix to show the last elements 'which were sometimes missed. '04b changes to allow for the "B" back to retain the hiliting capabilities vvversion = "Version January 05/01" 'remove reference to Cmd(13) back_cnt and Cmd(19) for re-use 'fixed the "D" date display by searching for "M" as both AM and PM have it.. 'if "." default to last search any other chr back to beginning and new search entry. vvversion = "Version January 06/01" 'skip duplicate code at line_12004b thru line_12005m as not required, moved some noshow logic 'do not include the counts for hilite_this or "append start" or "append end" vvversion = "Version January 08/01" 'fix the logic for wrap_cnt somewhat so the V & B for back work a little better (still not completely checked out) vvversion = "Version January 09/01" 'add the "crop" option to shorten very long lines that cause wraping problems vvversion = "Version January 10/01" 'allow for the over_lap element 13 on the crop and the wrap function later. vvversion = "Version January 19/01" 'the wrap array logic mostly complete with code bypassing this till the 12000 routine completed. vvversion = "Version January 20/01" 'the new wrap array and hi-lite logic testing being done vvversion = "Version January 21/01" 'add in logic to print last "endstuff" if A for All and wrap info unprinted vvversion = "Version January 22/01" 'removed the old hi-lite wrap logic at sub_12000: vvversion = "Version January 24/01" 'minor fix to hi-lite elements that wrap on to next page... vvversion = "Jan 25/01" 'change the A for append for Z to paste at the end of the file (confused with a for all) vvversion = "Jan 27/01" 'fix to skip the noshow elements if SS screen saver vvversion = "Jan 28/01" 'use tot_s1 to count the number of emails on the import function vvversion = "Jan 31/01" 'check if app is running and set App.Title to Keep-It vvversion = "Feb 01/01" 'check for computer name mine and ken's and anyone else vvversion = "Feb 06/01" 'allow the esc to stop the screen saver leave in old logic for any other key though vvversion = "Feb 09/01" 'if interrupted allow for them to continue vvversion = "Feb 16/01" 'add the date and time on the file prompt line vvversion = "Mar 01/01" 'allow for "A" for all to be entered at the interrupt prompt 'Feb 19/01 display the file name in each of the prompt boxes 'feb 20/01 setfocus to solve the problem of the interrupt not working after "CH" called then F or SS done 'feb 21/01 add image control set the stretch property to true (for full screen display) 'feb 25/01 add check for only "CH" when using setfocus as it seems to screw up other functions? 'feb 28/01 check for bounary=""" as it crapped out when wrong boundary found 'Mar 14/01 allow for WAIT= to pause line longer ie wait 30 etc fix the timer error at line_30000: area 'Mar 15/01 allow for SC screen capture to pause before the inputbox statements so that the displayed info can be capured using alt/print screen 'Mar 17/01 allow for CP copy picture to a directory in Cmd(23) element 'Mar 21/01 add in a was=scn0321.jpg to the text on a CP so we know the original number & date 'Mar 31/01 set the P1 as the stretch default and P2 non stretched (they will have to user P2 for sizing original scans) 'Apr 01/01 the GF get file routine to catalogue any pictures in the target directory 'Apr 05/01 allow for keeping the same name if no leading didgits entered. 'Apr 06/01 allow for 5000 folders when using the gf option 'Apr 08/01 allow for c:\search\tempfold\ to keep the original name on file copy 'Apr 10/01 allow for HL and HLL to use the append_start1 and append_end1 elements hilite_this could also be used??? 'allow for uppercase on all 3 of them working well so far 'Apr 11/01 allow for c:\* to do the whole c drive and * FOR file type 'and put out the date if dirdates entered 'Apr 22/01 allow for hhxxx. to display pictures at the end of screen promopt ' by putting in a HH when some hilited. 'may 06 2001 on interrupt of screen saver switch into photo display p1 ' allowing the user to do a "P" to see one of the various previous pictures ' as well at the photo continue prompt allow "SS" to continue screen saver ' with the previous screen saver settings ' vvversion = "May 06/01" 'this is the date of the compile only, just for the users info 'vvversion = 28 april 2002 add in the ww like ss with anded search criteria 'ver=1.04 added the ability to clear date to left by removing 1 character at a time and ' re-displaying what is left (looks like motion) vvversion = "19 February 2008 1.50" 'this is the date of the compile only, just for the users info 'look for "check the latest features above" where to add new features to help file If temp1 <> 0 And ddemo = "YES" Then Print vvversion; " of " + program_info ' Print "check web site: http://www.telusplanet.net/public/stonedan" Print "e-mail Doug Pederson stonedan@telusplanet.net" Print "for newer versions with more options" Print "shareware" Print "this info only displays on the first of month" Print "Enter to continue" tt1 = InputBox("Enter to continue", "Continue Prompt", , xx1 - offset1, yy1 - offset2) End If 'year must be 2000 ' do not allow use if date past best before date??? ' Print "UserName="; UserName; "=" ' tt1 = InputBox("testing prompt", , , 4400, 4500) 'TESTING ONLY If strBuffer <> "STONEMAN" Then GoTo line_30 'vip todo comment out to activate If strBuffer = "STONEMAN" Then GoTo line_30 'february 01 2001 If UserName = "stoneman" Then GoTo line_30 If UCase(UserName) = "KENNETH" Then GoTo line_30 'february 02 2001 If UCase(UserName) = "KEN M" Then GoTo line_30 'february 02 2001 If strBuffer = "KEN" Then GoTo line_30 'february 02 2001 MsgBox strBuffer + "=invalid computer " + UserName + "=username" GoTo End_32000 'february 01 2001 line_30: If date_check <> "YES" Then GoTo File_40 'no date check if disabled End If 'october 27 2000 If ddemo = "YES" Then GoTo File_40 'no date check on demo version End If 'as it is restricted enough 'date check should be good till end of march 2001 SSS = Format(Now, "ddddd ttttt") 'display today temp2 = InStr(SSS, "/") temp1 = InStr(temp2 + 1, SSS, "/00") ' Print "invalid date="; SSS; "=" ' tt1 = InputBox("year not /00", , , 4400, 4500) 'TESTING ONLY If temp1 = 0 Then temp1 = InStr(temp2 + 1, SSS, "/2000") End If If temp1 = 0 Then temp1 = InStr(temp2 + 1, SSS, "/01") End If If temp1 = 0 Then temp1 = InStr(temp2 + 1, SSS, "/2001") End If 'to activate for windows 2000 need a proper date check here as with ME above If temp1 = 0 Then Print "invalid date="; SSS; "=" tt1 = InputBox("year not /00 or /01", , , xx1 - offset1, yy1 - offset2) 'TESTING ONLY GoTo End_32000 End If 'year must be 2000 line_35: If Left(SSS, 1) = " " Then SSS = Right(SSS, Len(SSS) - 1) GoTo line_35 End If If Left(SSS, 3) <> "10/" And Left(SSS, 3) <> "11/" _ And Left(SSS, 3) <> "12/" And Left(SSS, 2) <> "1/" _ And Left(SSS, 2) <> "2/" And Left(SSS, 2) <> "3/" Then ' Then Print "software expired="; SSS; "=" tt1 = InputBox("e-mail stonedan@telusplanet.net", , , xx1 - offset1, yy1 - offset2) 'TESTING ONLY GoTo End_32000 End If 'must be march also screen_capture = "NO" 'march 15 2001 File_40: save_line = "40" Close #ExtFile 'march 18 2001 copy_photo = "NO" 'march 18 2001 '09 december 2002 rand = 0 '18 august 2002 text_pause = 0 '05 october 2002 debug_photo = False '12 october 2002 ' debug_photo = True '01 february 2003 09 september 2003 tt1 = "" encript = "" prev_option = "" If extract_yes = "YES" Then Close #ExtFile line_len = Val(Cmd(21)) End If 'november 12 2000 tot_s1 = 0 'january 01 2001 tot_s2 = 0 'january 01 2001 tot_s3 = 0 'january 01 2001 tot_s4 = 0 '23 june 2002 tot_s5 = 0 '23 june 2002 tot_s6 = 0 extract_yes = "" 'november 12 2000 skip_info = "" 'november 14 2000 ' img_ctrl = "NO" 'february 21 2001 img_ctrl = "YES" 'march 31 2001 stretch_img = "YES" 'march 31 2001 '22 december 2002 ' If UCase(Cmd(38)) = "STRETCH" Then ' stretch_info = " (STRETCH)" '21 december 2002 ' Else ' stretch_info = " (NORMAL)" ' End If dbltime1 = 0 dbltime2 = 0 line_45: 'december 3 2000 boundarycnt = 0 'december 31 2000 boundarystr = "" 'december 31 2000 mbxyes = "" 'december 17 2000 dateskip = "F" 'december 23 2000 GoSub InputFile_24000 'march 20/00 ' Print "tt1 SAVE_ttt="; tt1; "="; SAVE_ttt ' ttt = InputBox("testing file_40", , , 4400, 4500) 'TESTING ONLY If tt1 = "" Then GoTo End_32000 End If append_start1 = "append start" 'april 10 2001 append_end1 = "append end" 'april 10 2001 mbxi = 0 'december 17 2000 emailsea = "" 'december 11 2000 SAVE_ttt = "in" 'december 10 2000 GoSub Control_28000 'december 10 2000 extract_yes = "" 'december 31 2000 photo_cnt = 0 'march 17 2001 dirdates = "" 'april 11 2001 hilite_hh = "" 'april 22 2001 hilite_cnt = 0 'april 22 2001 If rand = -1 Then '09 december 2002 Randomize 'use system timer to start randomizer cnt = 99999999 GoSub line_30920 ' rand_cnt = zzz_cnt - 3 'keep the total number of records in file rand_cnt = zzz_cnt - 6 'keep the total number of records in file 28 april 2003 (this fixed it) ver=1.04a 'seems to loop if it hits end of file 'Hint: (place 6 blank lines at end of file 'so last 3 pictures can be seen in random mode. zzz_cnt = 0 ' xtemp = InputBox(" testing doug " + CStr(rand_cnt), "testing Prompt ", , xx1 - offset1, yy1 - offset2) rand_no = Int(rand_cnt * Rnd + 1) 'this line moves to after hits or misses End If '09 december 2002 What_50: save_line = "50" 'for error handling pp_entered = "" 'november 6 2000 SSS = Format(Now, "ddddd ttttt") 'display today 'deactivate the date check below have the program work for ever DoEvents ' Err.Raise 6 'test this to give error info ' works for all error numbers ' Beep 'test the beep bell prompt2 = "" ppoffset1 = 0 '27 july 2002 ppoffset2 = 0 '27 july 2002 'find out what can be called of use **vip** todo 'test area for ggg = GetSetting("?","*") ' ggg = GetSetting("RegCust", "Startup", "LastEntry", "0") ' Print "ggg="; ggg; "=" ' tt1 = InputBox("testing What_50", , , 4400, 4500) 'TESTING ONLY ' save_line = "50 testing" 'testing only ' ggg = LoadResData("C:|Program Files\Plus!\Themes\UNDERW~5.WAV", 6) ' Print "ggg="; ggg; "=" ' tt1 = InputBox("testing What_50", , , 4400, 4500) 'TESTING ONLY '********************************************************* 'main option entry here entry option prompt '********************************************************* '10 august 2002 allow for different keep options for photo file and text files If xxx_found = "YES" Then Cmd(20) = Cmd(41) Cmd(33) = "PHOTO" ' tt1 = InputBox("testing 01 January 2005", , , 4400, 4500) 'TESTING ONLY End If If xxx_found = "NO" Then Cmd(20) = Cmd(42) Cmd(33) = "D" End If '10 august 2002 use the cmd(20) and over-ride with above ' If xxx_found = "NO" And UCase(Cmd(20)) <> "Q" Then ' Cmd(20) = "C" ' Cmd(33) = "D" ' End If 'november 3 2000 ' If xxx_found = "YES" Then ' Cmd(20) = "P" ' Cmd(33) = "PHOTO" 'december 18 2000 ' End If 'november 3 2000 '10 august 2002 comment out the above logic iimport = "" 'december 24 2000 If InStr(UCase(TheFile), "\MAIL\") <> 0 And SAVE_ttt = "in" Then Cmd(20) = "email" 'december 12 2000 If InStr(UCase(TheFile), "\OUTLOOK EXPRESS\") <> 0 And SAVE_ttt = "in" Then Cmd(20) = "email" 'december 13 2000 Set Picture = LoadPicture() 'lp#1 page_prompt = "" 'december 31 2000 MAX_CNT = Val(Cmd(1)) 'december 31 2000 Context_lines = Val(Cmd(22)) 'december 31 2000 If Context_lines > 40 Then Context_lines = 40 'February 04 2001 mess_cnt = 0 'january 03 2001 array_pos = 0 'january 21 2001 array_prt = 0 temp_sec = -1 'march 14 2001 ' WinSeek.Show 'february 26 2001 ' WinSeek.SetFocus 'february 26 2001 ' frmOption1.Caption = "Option prompt" 'february 26 2001 ' MDIOption1.Show 'february 26 2001 ' xtemp = InputBox("testing prompt_ after option1 show=" + TheFile + "*" + UCase(xtemp) + "*" + CStr(wrap_cnt) + " " + CStr(cnt), "test", , 4400, 4500) ' ' SetFocus 'february 26 2001 ' Unload frmOption1 'february 26 2001 If screen_capture = "YES" Then new_delay_sec = 5 '03 September 2004 GoSub line_30300 '03 September 2004 ' delay_sec = 5 'march 15 2001 ' GoSub line_30000 End If dsp_cnt = 0 'may 12 2001 dbltime2 = Timer 'get the end time may 12 2001 Test1_str = "" If dbltime1 <> 0 And dbltime1 <> dbltime2 Then Test1_str = " elap=" + Format(dbltime2 - dbltime1, "#####0.000") End If 'show elapsed times may 12 2001 multi_prompt2 = "" '04 September 2004 Get_no2: 'march 21 2002 interrupt_prompt2 = "" '12 April 2008 search_str = "" '26 august 2002 ' xtemp = InputBox(" input prompt #2 multi_prompt2 " + multi_prompt2 + "*" + ttt, " testing Prompt #2 ", , xx1 - offset1, yy1 - offset2) If Cmd(20) = "Y" And SAVE_ttt <> "in" Then Cmd(20) = "" '15 december 2004 If Len(multi_prompt2) > 0 Then temp1 = InStr(1, multi_prompt2, sep) If temp1 <> 0 Then ttt = Left(multi_prompt2, temp1 - 1) multi_prompt2 = Right(multi_prompt2, Len(multi_prompt2) - temp1) ' xtemp = InputBox(" input prompt #2* multi_prompt2 " + multi_prompt2 + "*" + ttt, " testing Prompt #2* ", , xx1 - offset1, yy1 - offset2) Else ttt = multi_prompt2 multi_prompt2 = "" ' xtemp = InputBox(" input prompt #2** multi_prompt2 =" + multi_prompt2 + "*" + ttt, " testing Prompt #2** ", , xx1 - offset1, yy1 - offset2) ' Cmd(20) = "" '05 September 2004 End If GoTo auto_p2 '04 September 2004 End If '04 September 2004 allow for multiple inputs at a time ' xtemp = InputBox(" input prompt #2 test " + auto_exe + "*", " testing Prompt #2 ", , xx1 - offset1, yy1 - offset2) '12 September 2004 If UCase(App.EXEName) = Trim(UCase(Cmd(45))) And Left(App.Path, 3) <> "C:\" Then ' If (UCase(App.EXEName) = Trim(UCase(Cmd(45))) And Left(App.Path, 3) <> "C:\") Or InStr(1, UCase(App.Path + App.EXEName), "BACKGRD") <> 0 Then If (UCase(App.EXEName) = Trim(UCase(Cmd(45))) And Left(App.Path, 3) <> "C:\") Or InStr(1, UCase(App.EXEName), "BACKGRD") <> 0 Then ttt = RTrim(Cmd(47)) 'the search options entered here for now use "WW" 'want to make it so multiple prompts can be done todo **vip** ' xtemp = InputBox(" backgrd test2", " testing Prompt #2* ", , xx1 - offset1, yy1 - offset2) If debug_photo Then '12 october 2002 xtemp = InputBox("DOUG TESTING AUTO PROMPT #2" + ttt, , , 4400, 4500) 'TESTING ONLY End If GoTo auto_p2 End If '07 december 2002 If Left(UCase(Cmd(71)), 11) = "BATCHFILE==" Then '27 October 2004 ttt = Right(Cmd(71), Len(Cmd(71)) - 11) ' xtemp = InputBox("27 october 2004 TESTING 1 =" + ttt, , , 4400, 4500) 'TESTING ONLY BatchFile = FreeFile Open ttt For Input As #BatchFile DoEvents ttt = "RRR" 'testing only re the close of the file etc... Line Input #BatchFile, ttt ' xtemp = InputBox("27 october 2004 TESTING 1a =" + ttt, , , 4400, 4500) 'TESTING ONLY ' interrupt_prompt2 = UCase(ttt) '20 November 2004 GoTo auto_p2 End If '27 October 2004 '19 august 2003 the following line deactivated. If xxx. not found then disable random. We want it random here '19 August 2003 If xxx_found = "NO" Then rand = 0 '19 january 2003 'the above can be over-ridden below ttt = InputBox("P P1 P2 TT WW SS CH X RAND NORAND RANDA NORANDA THUMB HELP option ", "Option Prompt #2 " + TheFile + Test1_str, UCase(Cmd(20)), xx1 - offset1, yy1 - offset2) ' frmproj2.BorderStyle = "0" '25 november 2002 ' frmproj2.BorderStyle = "0" '25 november 2002 '10 august 2002 allow for cmd(41) and cmd(42) to override ' interrupt_prompt2 = UCase(ttt) '20 November 2004 auto_p2: '07 december 2002 ttt = UCase(ttt) '07 december 2002 If inin = "" Then start_point = 0 '21 February 2007 start_point = 10 '11 March 2007 line_start_point = start_point '21 February 2007 End If '21 February 2007 '04 September 2004 below If InStr(1, ttt, sep) <> 0 Then temp1 = InStr(1, ttt, sep) multi_prompt2 = Right(ttt, Len(ttt) - temp1) ttt = Left(ttt, temp1 - 1) ' xtemp = InputBox(" input prompt #2a multi_prompt2 " + multi_prompt2 + "*" + ttt, " testing Prompt #2a ", , xx1 - offset1, yy1 - offset2) End If '04 September 2004 If Left(ttt, 6) = "SPEED=" Then play_speed = Val(Right(ttt, Len(ttt) - 6)) GoTo Get_no2 End If '29 October 2003 testing this a bit p2p2 = UCase(ttt) '10 august 2002 If ttt = "SS" And ss_only <> "YES" Then ss_only = "YES" GoTo Do_Search_110 End If '07 december 2002 If p2p2 = "DEBPHO" Then debug_photo = True GoTo Get_no2 End If '12 october 2002 allow for debug of photo problems '16 July 2003 testing only below If Left(p2p2, 7) = "START==" Then start_point = Val(Right(p2p2, Len(p2p2) - 7)) line_start_point = start_point '22 March 2004 GoTo Get_no2 End If '16 July 2003 Ver=1.07T testing the start point If Left(p2p2, 4) = "ELAP" Then elapse_yn = "YES" '13 July 2003 GoTo Get_no2 End If '13 July 2003 If p2p2 = "PAUSE" Or p2p2 = "PA" Then text_pause = True extract_yes = "NO" 'do not want these two taking up disc space auto_redraw = "NO" frmproj2.AutoRedraw = False inin = "" GoTo Get_no2 End If '05 october 2002 If p2p2 = "RAND" Then rand = -1 Randomize 'use system timer to start randomizer cnt = 99999999 GoSub line_30920 rand_cnt = zzz_cnt - 3 'keep the total number of records in file 'seems to loop if it hits end of file zzz_cnt = 0 ' xtemp = InputBox(" testing doug " + CStr(rand_cnt), "testing Prompt ", , xx1 - offset1, yy1 - offset2) rand_no = Int(rand_cnt * Rnd + 1) 'this line moves to after hits or misses ' If rand Then ' xtemp = InputBox(" testing doug randomiser rnd " + CStr(rand_no), "testing Prompt ", , xx1 - offset1, yy1 - offset2) ' End If GoSub Control_28000 '22 december 2002 Cmd(49) = "RANDOM" '09 December 2002 ' random_info = " (RANDOM)" '21 december 2002 GoSub line_30800 'kill and update the control file frmproj2.Caption = program_info + random_info + stretch_info '09 december 2002 GoTo Get_no2 End If '18 august 2002 If p2p2 = "NORAND" Then rand = 0 GoSub Control_28000 Cmd(49) = "NORANDOM" '09 december 2002 '22 december 2002 ' random_info = "" '21 december 2002 GoSub line_30800 'kill and update the control file frmproj2.Caption = program_info + stretch_info '09 december 2002 GoTo Get_no2 End If '09 december 2002 If p2p2 = "DETAIL" Then GoSub Control_28000 Cmd(56) = "PHOTO_DETAIL" '18 November 2004 GoSub line_30800 'kill and update the control file detailyn = "PHOTO_DETAIL" '18 November 2004 GoTo Get_no2 End If '18 November 2004 If p2p2 = "NODETAIL" Then GoSub Control_28000 Cmd(56) = "noPHOTO_DETAIL" '18 November 2004 GoSub line_30800 'kill and update the control file detailyn = "noPHOTO_DETAIL" '18 November 2004 GoTo Get_no2 End If '18 November 2004 If Left(p2p2, 4) = "THUM" Then thumb_nail = "YES" '16 July 2003 ver=1.07T GoSub Control_28000 Cmd(67) = "THUMB" '14 April 2004 GoSub line_30800 GoTo Get_no2 End If If Left(p2p2, 6) = "NOTHUM" Then thumb_nail = "NO" GoSub Control_28000 Cmd(67) = "noTHUMB" '14 April 2004 GoSub line_30800 GoTo Get_no2 End If '23 March 2004 If p2p2 = "RANDA" Then rand1 = -1 Randomize GoSub Control_28000 Cmd(65) = "RANDBEG" GoSub line_30800 GoTo Get_no2 End If If p2p2 = "NORANDA" Then rand1 = 0 GoSub Control_28000 Cmd(65) = "noRANDBEG" GoSub line_30800 GoTo Get_no2 End If '23 March 2004 add random start point in video If p2p2 = "NOVIDEO" Then GoSub Control_28000 Cmd(53) = "NOSHOWVIDEO" '10 FEBRUARY 2003 GoSub line_30800 'kill and update the control file videoyn = "NOSHOWVIDEO" GoTo Get_no2 End If '10 FEBRUARY 2003 If p2p2 = "VIDEO" Then GoSub Control_28000 Cmd(53) = "SHOWVIDEO" '10 FEBRUARY 2003 GoSub line_30800 'kill and update the control file videoyn = "SHOWVIDEO" GoTo Get_no2 End If '10 FEBRUARY 2003 '05 december 2002 If p2p2 = "P1" Or p2p2 = "P2" Or p2p2 = "WW" Or p2p2 = "SS" Then 'midway thru the program appx If p2p2 = "P" Or p2p2 = "WW" Or p2p2 = "SS" Then If Cmd(41) <> p2p2 Then GoSub Control_28000 Cmd(41) = p2p2 GoSub line_30800 'kill and update the control file End If End If '10 august 2002 '15 December 2004 If p2p2 = "C" Or p2p2 = "S" Or p2p2 = "Q" Or p2p2 = "CC" Then If p2p2 = "C" Or p2p2 = "S" Or p2p2 = "Q" Or p2p2 = "CC" Or p2p2 = "Y" Then If Cmd(42) <> p2p2 Then GoSub Control_28000 Cmd(42) = p2p2 GoSub line_30800 'kill and update the control file End If End If '10 august 2002 If p2p2 = "CC" Then search_str = "CC" '26 august 2002 p2p2 = "S" prompt2 = "S" ttt = "S" End If dbltime2 = Timer 'may 12 2001 dbltime1 = Timer 'Get the start time may 12 2001 prev_ttt = ttt 'april 10 2001 If UCase(ttt) = "Z" Then prev_option = "" 'february 25 2001 If prev_option = "CH" Then SetFocus 'this solved the problem of the esc / enter not interrupting End If 'the program once the "CH" option was done february 20 2001 line_60: 'february 09 2001 tt1 = ttt 'november 14 2000 ttt = UCase(ttt) 'all to upper case june 14/99 If ttt = "M" Then frmproj2.WindowState = 1 '0=normal 1 = min 2 = max 'when I used co-ordinates of 40000 , 40000 below the input box failed and 'it skipped immediately to the get_no2 prompt what the hey ttt = InputBox(" window state prompt", "minimized ", "WHAT", 20000, 20000) frmproj2.WindowState = 2 ' GoTo Get_no2 End If 'march 21 2002 ' "Y" for yesterday display in text file december 09 2001 ' read till end of file then do similar to the "B" option If ttt = "Y" Then save_line = "65" OutFile = FreeFile Open TheFile For Input As #OutFile DoEvents 'yield to operating system dblStart = Timer 'get the start time line_65: Line Input #OutFile, aaa zzz_cnt = zzz_cnt + 1 GoTo line_65 End If If ttt = "HELP" Then rand = 0 '10 december 2002 Close #OutFile DoEvents DoEvents GoSub line_30900 Close #OutFile DoEvents OutFile = FreeFile Open "help.txt" For Input As #OutFile DoEvents prompt2 = "C" printed_cnt = 1 'otherwise the "reading 1" shows up on screen inin = "A" 'forces all data to be displayed SSS1 = "" 'when set to "A" only lines with "A" in displayed SAVE_KEEPS1 = "==" 'the search match is an and (just use one at a time) SAVE_KEEPS2 = "CMD(" '**vip** the search here must be in all capitals SAVE_KEEPS3 = ") " 'use this for some other display all caps SAVE_KEEPS4 = "" '09 JUNE 2002 SAVE_KEEPS5 = "" SAVE_KEEPS6 = "" SAVE_ttt = "C" 'this ensures it is "C" context display Picture_Search = "" 'this one was important in making the help work hi_lites = "YES" Cls 'clear the screen ' can not seem to get this routine to display the hilites on the second pass ' after a photo has been displayed and the option prompt "help" request ' not a big deal but just having no luck today october 22 2001 ' SSS = SAVE_KEEPS1 + sep + SAVE_KEEPS2 + sep + SAVE_KEEPS3 ' xtemp = InputBox("DOUG 1 TESTING SSS1 SSS2 SSS3" + SSS1 + SSS2 + SSS3, , , 4400, 4500) 'TESTING ONLY ' xtemp = InputBox("DOUG 2 TESTING SAVE_ttt hi_lites" + SAVE_ttt + "," + hi_lites, , , 4400, 4500) 'TESTING ONLY ' KEEPS1 = "" ' KEEPS1 = "" ' KEEPS2 = "" ' KEEPS3 = "" ' xtemp = InputBox("DOUG 3 TESTING KEEPS1 KEEPS2 KEEPS3 " + KEEPS1 + "," + KEEPS2 + "," + KEEPS3, , , 4400, 4500) 'TESTING ONLY ' xtemp = InputBox("DOUG 4 TESTING tt1" + tt1, , , 4400, 4500) 'TESTING ONLY ' tt1 = "" ' xtemp = InputBox("DOUG 5 TESTING save_search" + save_search, , , 4400, 4500) 'TESTING ONLY ' xtemp = InputBox("DOUG 6 TESTING SAVE_KEEPS1" + SAVE_KEEPS1, , , 4400, 4500) 'TESTING ONLY ' xtemp = InputBox("DOUG 7 TESTING SAVE_KEEPS2" + SAVE_KEEPS2, , , 4400, 4500) 'TESTING ONLY ' line_match = "Y" GoTo input_1000a End If 'october 14 2001 If ttt = "DIRDATES" Then dirdates = "Y" GoTo What_50 End If 'april 11 2001 If Left(ttt, 2) = "HH" Then hilite_this = Mid(prev_ttt, 3) GoSub Control_28000 '19 january 2003 Cmd(31) = Mid(prev_ttt, 3) ' only hilites data not on matching line GoSub line_30800 '19 january 2003 hilite_hh = "Y" 'april 22 2001 GoTo What_50 End If 'april 10 2001 If Left(ttt, 3) = "HLL" Then append_end1 = Mid(prev_ttt, 4) GoTo What_50 End If 'april 10 2001 If Left(ttt, 2) = "HL" And Mid(ttt, 3, 1) <> "L" Then append_start1 = Mid(prev_ttt, 3) GoTo What_50 End If 'april 10 2001 If ttt = "P1" Then img_ctrl = "YES" 'march 31 2001 stretch_img = "YES" 'march 31 2001 '22 december 2002 ' stretch_info = " (STRETCH)" '21 december 2002 ' frmproj2.Caption = program_info + random_info + stretch_info '09 december 2002 GoSub Control_28000 'october 07 2001 read the most current then update Cmd(38) = "stretch" search_prompt = "in" 'october 07 2001 GoSub line_30800 'september 23 2001 frmproj2.Caption = program_info + random_info + stretch_info '22 december 2002 If debug_photo Then '12 october 2002 xtemp = InputBox("DOUG TESTING photo 1" + ttt, , , 4400, 4500) 'TESTING ONLY End If ttt = "P1" 'OCTOBER 07 2001 ttt = "P" '05 december 2002 GoTo What_50 '05 december 2002 End If 'march 31 2001 If ttt = "P" Then ttt = "P1" End If 'september 23 2001 If ttt = "SC" Then screen_capture = "YES" 'march 15 2001 GoTo What_50 End If If ttt = "DIR" Then ttt = "GF" 'february 18 2002 diryes = "DIR" dirdates = "Y" End If 'february 18 2002 Mergem = "NO" 'february 24 2002 If ttt = "MERGE" Then ttt = "GF" 'february 24 2002 diryes = "DIR" dirdates = "Y" Mergem = "YES" End If 'february 24 2002 If ttt = "GF" Then GoSub Control_28000 rand = 0 '19 July 2003 take random off GF option Cmd(49) = "NORANDOM" GoSub line_30800 'kill and update the control file '19 July 2003 (somehow having random set causes the tag record 'on mp3 files not to be read properly (so this should be a temp fix) GoSub Control_28000 '19 July 2003 Close #OutFile '18 August 2004 so there is no conflict with file opened at prompt number 1 one GoSub line_30700 'april 01 2001 '15 december 2002 GoTo What_50 GoTo File_40 End If If Left(ttt, 2) = "PC" Then photo_cnt = Val(Mid(ttt, 3)) - 1 GoTo What_50 End If 'march 17 2001 If ttt = "CP" Then copy_photo = "YES" 'march 17 2001 'need to allow for change of file name etc here xtemp = Cmd(19) GoSub line_16000 ' If UCase(FileExt) = UCase(TheFile) Then ttt = "X" GoTo File_40 End If 'might want to make the open below append or new ' save_line = "16100-1" '18 March 2007 testing only only GoSub line_16100 'open the replace.txt for output xtemp = InputBox(" output directory (you can rename folder later)", "Directory Prompt ", Cmd(23), xx1 - offset1, yy1 - offset2) temps = xtemp If Len(temps) < 4 Then GoTo What_50 End If 'april 08 2001 save_dir: photo_dir = xtemp 'ie c:\search\tempfold\ xtemp = InputBox(" keep original file name Y/N (pict for pict01 & pict02 etc)", "Output file name prompt ", "Y", xx1 - offset1, yy1 - offset2) photo_file = xtemp 'ie pict If xtemp = "Y" Then photo_file = "" ' xtemp = InputBox("testing dir" + photo_dir, , , 4400, 4500) 'TESTING ONLY ' xtemp = InputBox("testing file" + photo_file, , , 4400, 4500) 'TESTING ONLY GoTo What_50 End If 'end "CP" if statement prev_option = ttt 'february 25 2001 If ttt = "P2" Then stretch_img = "NO" 'march 31 2001 '22 december 2002 ' stretch_info = " (NORMAL)" '21 december 2002 ' frmproj2.Caption = program_info + random_info + stretch_info '25 november 2002 ' img_ctrl = "YES" 'february 21 2001 img_ctrl = "NO" 'march 31 2001 ttt = "P1" GoSub Control_28000 'october 07 2001 Cmd(38) = "normal" 'september 23 2001 search_prompt = "in" 'october 07 2001 GoSub line_30800 'september 23 2001 frmproj2.Caption = program_info + random_info + stretch_info '25 november 2002 ' xtemp = InputBox("TESTING DOUG photo 2" + ttt, , , 4400, 4500) 'TESTING ONLY ttt = "P1" 'OCTOBER 07 2001 ttt = "P" '05 december 2002 GoTo What_50 '05 december 2002 End If If Cmd(20) = "email" And ttt = "IMPORT" Then emailsea = "Y" iimport = "Y" 'december 24 2000 ttt = "F" 'for flash display extract_yes = "YES" xtemp = Cmd(19) GoSub line_16000 'get file name If UCase(FileExt) = UCase(TheFile) Then ttt = "X" GoTo File_40 End If 'january 22 2001 ' save_line = "16100-2" '18 March 2007 testing only only GoSub line_16100 'january 01 2001 End If Cmd(20) = "" 'december 7 2000 xxx_found = "" 'december 7 2000 If ddemo = "YES" And ttt = "" Then GoTo line_80 End If 'demo only allows the P1 and the SS options If ddemo = "YES" And ttt <> "P1" And ttt <> "X" And ttt <> "RRR" And ttt <> "SS" Then GoTo What_50 End If 'december 11 2000 re the emailsea option email If ttt = "EMAIL" Then emailsea = "Y" ttt = "C" End If If ttt = "R" Then page_prompt = "NO" extract_yes = "YES" xtemp = Cmd(19) GoSub line_16000 If UCase(FileExt) = UCase(TheFile) Then ttt = "X" GoTo File_40 End If 'january 22 2001 ' save_line = "16100-3" '18 March 2007 testing only only GoSub line_16100 'january 01 2001 ttt = "Q" End If 'december 31 2000 If ttt = "CROP" Then GoSub line_30600 'crop the input file to a given length SAVE_ttt = "" GoTo File_40 End If 'december 31 2000 If ttt = "DISC" Then MsgBox strMessage strMessage = App.Path + "*" + App.EXEName '07 december 2002 MsgBox strMessage GoTo What_50 End If 'january 31 2001 If ttt = "D" Then page_prompt = "NO" extract_yes = "YES" xtemp = Cmd(19) GoSub line_16000 ' xtemp = InputBox("testing prompt_=" + TheFile + "*" + UCase(xtemp) + "*" + CStr(wrap_cnt) + " " + CStr(cnt), "test", , 4400, 4500) ' If UCase(TheFile) = UCase(FileExt) Then ttt = "X" GoTo File_40 End If 'january 22 2001 ' save_line = "16100-4" '18 March 2007 testing only only GoSub line_16100 'january 01 2001 'january 01 2001 MAX_CNT = 5 'january 01 2001 Context_lines = 2 MAX_CNT = context_win Context_lines = Int((context_win - 1) / 2) If Context_lines > 40 Then Context_lines = 40 'january 28 2001 ttt = "C" End If 'december 31 2000 If ttt = "T" Then page_prompt = "NO" extract_yes = "YES" xtemp = Cmd(19) GoSub line_16000 If UCase(FileExt) = UCase(TheFile) Then ttt = "X" GoTo File_40 End If 'january 22 2001 ' save_line = "16100-5" '18 March 2007 testing only only GoSub line_16100 'january 01 2001 ttt = "S" 'see logic below for changing S to Q for search End If 'january 01 2001 'november 14 2000 the following stuff moved up to do_search area uppercase = "N" 'december 8 2000 If ttt = "S" Then uppercase = "Y" ttt = "Q" End If 'december 8 2000 If ttt = "XXX" Then extract_yes = "YES" 'november 12 2000 text_pause = 0 '05 october 2002 don't want these two taking up disc xtemp = Cmd(19) GoSub line_16000 'get the file name november 17 2000 If UCase(FileExt) = UCase(TheFile) Then ttt = "X" GoTo File_40 End If 'january 22 2001 ' save_line = "16100-6" '18 March 2007 testing only only GoSub line_16100 'january 01 2001 GoTo What_50 End If If ttt = "LL" Then line_len = Val(Cmd(21)) GoTo What_50 End If 'december 6 2000 If Left(ttt, 2) = "LL" Then line_len = Val(Right(ttt, Len(ttt) - 2)) GoTo What_50 End If 'december 6 2000 If Left(ttt, 7) = "SHOWPOS" Then showpos = "Y" GoTo What_50 End If 'december 6 2000 '**keep** the showpos is handy to check the wrap functions for problems 'and there will be problems If Left(ttt, 7) = "SHOWASC" Then showasc = "Y" GoTo What_50 End If 'december 6 2000 If Left(ttt, 4) = "SKIP" Then skip_info = Right(tt1, Len(tt1) - 4) GoTo What_50 'november 14 2000 End If If Left(ttt, 2) = "NS" And Len(ttt) > 2 Then Cmd(28) = " " + Cmd(28) + " " + Right(ttt, Len(ttt) - 2) + " " GoSub line_29100 'set up new noshow elements GoTo What_50 End If 'november 03 2000 allow switch between two control files ie for font sizes etc If Left(ttt, 3) = "CCC" Then ' control_file = "c:\control1.txt" control_file = "control1.txt" 'december 3 2000 hint use control1.txt to switch multiple settings at once GoSub Control_28000 DoEvents ' control_file = "c:\control.txt" '23 september 2002 control_file = "control.txt" 'december 3 2000 SAVE_ttt = "in" 'november 23 2000 GoTo What_50 End If If Left(ttt, 2) = "SS" And Len(ttt) > 2 Then Cmd(26) = " " + Right(ttt, Len(ttt) - 2) + " " ' ss_search = Right(ttt, Len(tt) - 2) + " " 'october 24 2000 GoSub line_29200 'set up new screen saver elements ' sscreen_saver = "Y" 'october 24 2000 ' prompt2 = "SS" ' Print "screensave(?)="; "*"; screensave(screencount); "*"; aaa; screencount; sscreen_saver; prompt2 ' tt1 = InputBox("testing screen saver logic", , , 4400, 4500) 'TESTING ONLY ttt = "SS" End If '28 april 2002 WW screen saver option added If Left(ttt, 2) = "WW" Then sscreen_saver_ww = "YES" interrupt_prompt2 = "" '23 November 2004 inin = "" ttt = "SS" Picture_Search = "YES" '26 November 2004 testing this doug ' ShowCursor = False '29 november 2002 ' Me.MousePointer = False '29 november 2002 End If If Left(ttt, 2) = "TT" And Len(ttt) > 2 Then GoSub Control_28000 delay_sec = Val(Right(ttt, Len(ttt) - 2)) 'set a new delay time on screen saver 'february 08 2002 the 4 lines below were added to save the delay time hold_sec = delay_sec Cmd(27) = Format(hold_sec, "###0.0000") delay_sec = hold_sec '29 november 2002 GoSub line_30800 delay_sec = hold_sec '18 November 2004 ' tt1 = InputBox("testing delay " + ttt + " " + Cmd(27), , , 4400, 4500) 'TESTING 22 March 2004 GoTo Get_no2 '05 September 2004 '05 September 2004 GoTo What_50 End If If ttt = "" And SAVE_ttt = "in" Then ttt = UCase(Cmd(20)) 'april 14/00 If ttt = " " Then ttt = "C" Cmd(20) = ttt End If End If 'default to "c" on incomming prompt2 = ttt + "" previous_count = 0 If ttt = "SS" Then ttt = "P1" If strecth_img = "NO" Then img_ctrl = "NO" 'march 31 2001 sscreen_saver = "Y" End If ' If UCase(Left(ttt, 3)) = "VVV" Then ' ppaste = Right(ttt, Len(ttt) - 3) ' GoTo What_50 ' End If If UCase(Left(ttt, 2)) = "VV" Then Clipboard.SetText Right(ttt, Len(ttt) - 2) 'see programmers guide page 170 re mdi forms and clipboard.settext GoTo What_50 End If crlf = "" 'December 2 2000 If UCase(ttt) = "QQQ" Then ttt = "RRR" crlf = "NO" End If 'add the option to do a search and replace If UCase(ttt) = "RRR" Then encript = "RRR" ' xtemp = InputBox("27 October testing 2" + ttt, , , 4400, 4500) 'TESTING ONLY GoSub replace_29000 GoTo File_40 End If 'do the encription here november 20 2000 If UCase(ttt) = "CRIPT" Then encript = "CRIPT" xtemp = Cmd(32) GoSub line_16000 GoSub line_29500 'encription array read case_yes = "Y" GoSub replace_29000 GoTo File_40 End If 'do the de-encription here november 20 2000 If UCase(ttt) = "DECRIPT" Then encript = "DECRIPT" xtemp = Cmd(32) GoSub line_16000 GoSub line_29500 'encription array read case_yes = "Y" GoSub replace_29000 GoTo File_40 End If 'set up for the de-encription here november 20 2000 If UCase(ttt) = "MYSTUF" Then encript = "MYSTUF" xtemp = Cmd(32) GoSub line_16000 GoSub line_29500 'encription array read case_yes = "Y" GoTo What_50 End If '10 January 2005 If text_pause Then If text_pause And p2p2 <> "F" Then MAX_CNT = MAX_CNT + 1 '06 January 2005 no need to display the end of screen stuff when pausing End If '06 January 2005 add 1 to the max number of lines to display here ' allow for the number of characters in string to do select If Len(ttt) = 0 Then GoTo line_80 If Len(ttt) = 1 Then GoTo line_80 If Len(ttt) = 2 And ttt = "P1" Then GoTo line_80 If Len(ttt) = 2 And ttt = "CH" Then GoTo line_80 If Len(ttt) = 2 Then ttt = "P" GoTo line_80 End If If Len(ttt) = 3 Then ttt = "P1" GoTo line_80 End If If Len(ttt) = 4 Then ttt = "CH" GoTo line_80 End If If Len(ttt) = 5 Then ttt = "Z" GoTo line_80 End If If Len(ttt) = 6 Then ttt = "E" GoTo line_80 End If If Len(ttt) = 7 Then ttt = "F" GoTo line_80 End If If Len(ttt) = 8 Then ttt = "S" GoTo line_80 End If If Len(ttt) = 9 Then ttt = "X" GoTo line_80 End If line_80: Test1_str = "P" ' Print "Cmd(20)="; Cmd(20); "=" If debug_photo Then '12 october 2002 tt1 = InputBox("testing photo 3", , , 4400, 4500) 'TESTING ONLY End If If ttt = "P1" Then ttt = "P" Test1_str = "P1" End If If ttt = "P2" Then ttt = "P" Test1_str = "P2" End If If ttt = "P3" Then ttt = "P" Test1_str = "P3" End If SAVE_ttt = ttt Cls 'clear screen each time 'enter data to end of file Picture_Search = "NO" If ttt = "P" Then Picture_Search = "YES" ttt = "C" GoTo Do_Search_110 SAVE_ttt = ttt End If 'march 31/00 If ttt = "Z" Then GoSub Do_Append_19000 GoTo What_50 End If 'march 28/00 If ttt = "CH" Then GoSub Do_Change_18000 DoEvents GoTo What_50 End If 'march 29/00 If ttt = "E" Then GoTo Do_Enter_20000 End If 'search and search with start If ttt = "S" Or ttt = "SS" Then GoTo Do_Search_110 End If 'flash search If ttt = "F" Then ' tt1 = InputBox("testing flash prompt", , , 4400, 4500) '04 September 2004 auto_redraw = "NO" frmproj2.AutoRedraw = False 'november 11 2001 'turn off redraw on flash display GoTo Do_Search_110 End If 'context search aug 08/99 If ttt = "C" Then GoTo Do_Search_110 'aug 08/99 End If 'quick search october 21 2000 If ttt = "Q" Then GoTo Do_Search_110 End If GoTo File_40 ' GoTo End_32000 Do_Search_110: save_line = "110" 'for error handling If img_ctrl = "YES" Then Set Image1.Picture = LoadPicture 'february 21 2001 End If If debug_photo Then '12 october 2002 tt1 = InputBox("testing photo 3.1", , , 4400, 4500) 'TESTING ONLY End If Close OutFile OutFile = FreeFile 'november 14 2000 If mbxyes = "Y" Then Open TheFile For Binary As #OutFile 'the main file open for input here vip Else Open TheFile For Input As #OutFile 'the main file open for input here vip End If SSS1 = "" SSS2 = "" SSS3 = "" SSS4 = "" '09 JUNE 2002 SSS5 = "" SSS6 = "" 'may 12 2001 dsp_cnt = 0 zzz_cnt = 0 zzz_chrs = 0 tot_disp = 0 ' zero count of lines displayed end_cnt = 0 'allow for more than 1 eof in file ' ScrollBars = True ' Picture1.Picture = LoadPicture("c:\temp.bmp") ' Picture2.Picture = Picture1.Picture ' Picture2.Top = 0 ' Picture2.Left = 0 ' Picture2.Width = Picture1.Width ' Picture2.Height = Picture1.Height ' II = DoEvents() ' PaintPicture Picture1.Picture, -1, -3300, 9400, 8000 ' MyAppID = Shell("C:\WINDOWS\KODAKIMG.EXE", 1) ' MyAppID = Shell("C:\WINDOWS\SYSTEM\VIEWERS\QUIKVIEW.EXE", 1) ' MyAppID = Shell("C:\PROGRAM FILES\ACCESSORIES\MSPAINT.EXE", 1) ' AppActivate MyAppID ' SendKeys "^o", True ' SendKeys "c:\temp.tif", True ' SendKeys "{c:\temp.bmp}", True ' SendKeys "%F1", 1 ' SendKeys "%F0C:\TEMP.BMP", 1 ' SendKeys " C:\TEMP.BMP" ' SendKeys Ctrl("o"), 1 ' SendKeys "^co" ' MyAppID = Shell("C:\PROGRAM FILES\colordesk utilities\photo\cdphoto.EXE", 1) ' MyAppID = Shell("C:\fbscanner\imagein3\imagein.EXE", 1) ' MyAppID = Shell("C:\PRORAM FILES\ACCESSORIES\IMAGEIN.EXE", 1) '******************************************************* ' * * * S E A R C H S T R I N G * * * entry option prompt '******************************************************* 'august 27/00 ' ttt = InputBox("Search String 'A' for ALL", , , 4400, 4500) ' ttt = UCase(ttt) TheSearch = "." '28 april 2002 If sscreen_saver = "Y" Then ' frmproj2.Caption = " do_search_110 dougdoug " + SAVE_SSS + "*" + interrupt_prompt2 + "*" + sscreen_saver + "*" + sscreen_saver_ww + "*" + SSS1 + "*" + SSS2 + "*" + ss_search '20 November 2004 test If sscreen_saver = "Y" And sscreen_saver_ww = "YES" And interrupt_prompt2 = "WW" Then '21 November 2004 ttt = SAVE_SSS '21 November 2004 ie like "OLDIE/IRENE" IN SAVE_SSS delay_sec = new_delay_sec '23 November 2004 set it back interrupt_prompt2 = "" '23 November 2004 was not allowing a WW entry at prompt two GoTo line_600 End If '21 November 2004 If sscreen_saver = "Y" And sscreen_saver_ww <> "YES" Then ttt = ss_search 'screen saver logic GoTo line_600 End If line_500: 'december 3 2000 If text_pause And inin <> "" Then ' tt1 = InputBox("testing pause " + p2p2 + "*" + inin + "*", , , 4400, 4500) GoTo line_510 '05 october 2002 End If If iimport = "Y" Then ttt = "kskdlskdj" 'skip search entry prompt GoTo line_510 'december 24 2000 End If If debug_photo Then '12 october 2002 tt1 = InputBox("testing photo 3.2", , , 4400, 4500) 'TESTING ONLY End If GoSub Search_26000 'get the string to find search prompt here ******* line_510: 'december 24 2000 ' Print ttt 'testing ' tt1 = InputBox("testing search_26000", , , 4400, 4500) If UCase(ttt) = "E" Or UCase(ttt) = "X" Then GoTo What_50 ' If Len(ttt) = 1 Then GoTo What_50 'january 05 2001 If (prompt2 = "P1" Or prompt2 = "P") And _ search_prompt = "in" And ttt = "" Then ttt = "PHOTO" GoTo line_600 End If If (prompt2 = "P1" Or prompt2 = "P") And _ UCase(ttt) = "A" Then ttt = "PHOTO" GoTo line_600 End If If search_prompt = "in" And ttt = "" Then ttt = Cmd(33) 'december 7 2000 ' ttt = "D" GoTo line_600 End If 'april 24/00 'default to day search on start If UCase(ttt) = "A" Then GoTo line_600 If UCase(ttt) = "D" Then GoTo line_600 If UCase(ttt) = "M" Then GoTo line_600 ' If ttt = "MM" Then GoTo line_600 ' If ttt = "DD" Then GoTo line_600 'december 28 2000 If Len(ttt) = 1 Then ttt = "." 'force display old searches 'december 28 2000 comment out the logic below 'any 2 matching characters will do a paste function Ctrl/V ' If Len(ttt) = 2 And Left(ttt, 1) = Right(ttt, 1) Then ' ttt = Clipboard.GetText(vbCFText) ' Print ttt 'testing only ' End If line_600: ' search_prompt = "D" search_prompt = Cmd(33) 'december 7 2000 printed_cnt = 1 'may 10/00 printed = "NO" TheSearch = ttt 'august 27/00 ' If TheSearch <> "" Then ' GoSub Search_26000 ' End If If ttt = "-" Then ttt = SAVE_SRCH + "" End If 'use last search if - entered 15mar00 If ttt <> "" Then If UCase(ttt) <> "A" Then SAVE_SRCH = ttt + "" 'save search for reuse 15mar00 End If 'november 6 2000 If prompt2 = "Q" And SSS <> "D" Then SAVE_SRCH = qqq + "" End If 'october 23 2000 End If SSS = UCase(ttt) 'Ensure all is upper case for search 'november 6 2000 'december 8 2000 If prompt2 = "Q" And SSS <> "D" Then If prompt2 = "Q" And SSS <> "D" And uppercase = "N" Then SSS = qqq 'no upper case in quickie search october 23 2000 End If SAVE_SSS = SSS + "" 'check for tabs here later and make them 4 or 5 spaces '20 August 2003 Cls 'june 27/99 cnt = 0 dblStart = Timer 'get the start time hi_lites = "NO" If SSS = "" Then Close #OutFile 'june 27/99 II = DoEvents 'june 27/99 GoTo What_50 End If 'if D entered switch with current date ie 6/14/99 as the ' search string in the format 6/6/14/99 '06 December 2004 testing previous day. '-------------------------------------------------- 'date is as 12/6/2004 for December 06 2004 returned with time also 'this will not do a previous month ie if sitting on 01 good enought for now. If SSS = "DX" Then SSS = Format(Now, "ddddd ttttt") 'display today temp1 = InStr(2, SSS, " ") temptemp = Trim(Left(SSS, temp1)) II = InStr(temptemp, "/") III = InStr(II + 1, temptemp, "/") temptemp = Mid(temptemp, II + 1, III - II + 1) temp1 = Val(temptemp) - 1 'the day is reduced by 1 here If temp1 = 0 Then temp1 = 1 'do not worry about last month for now temptemp = CStr(temp1) temptemp = Left(SSS, II) + CStr(Val(temptemp)) + Right(SSS, Len(SSS) - III + 1) SSS = temptemp temp1 = InStr(2, SSS, " ") 'case it changes from 10 to 9 etc ' frmproj2.Caption = " 06 Dec 2004 testing=" + temptemp + "=" '06 December 2004 ' new_delay_sec = 2 '06 December 2004 testing ' GoSub line_30300 '06 December 2004 testing ' SSS = " " + sep + " " + sep + Left(SSS, temp1 - 1) '09 june 2002 SSS = "M" + sep + ":" + sep + Left(SSS, temp1 - 1) 'january 05 2001 SSS = "M" + sep + "M" + sep + "M" + sep + "M" + sep + ":" + sep + Left(SSS, temp1 - 1) 'january 05 2001 End If '-------------------------------------------------- If SSS = "D" Then SSS = Format(Now, "ddddd ttttt") 'display today ' frmproj2.Caption = " 06 Dec 2004 testing=" + SSS + "=" '06 December 2004 ' new_delay_sec = 2 '06 December 2004 testing ' GoSub line_30300 '06 December 2004 testing temp1 = InStr(2, SSS, " ") ' SSS = " " + sep + " " + sep + Left(SSS, temp1 - 1) '09 june 2002 SSS = "M" + sep + ":" + sep + Left(SSS, temp1 - 1) 'january 05 2001 SSS = "M" + sep + "M" + sep + "M" + sep + "M" + sep + ":" + sep + Left(SSS, temp1 - 1) 'january 05 2001 End If If SSS = "DD" Then SSS = " " + sep + " " + sep + date_displayed 'day of last find End If If SSS = "M" Then SSS = Format(Now, "ddddd ttttt") 'display this month temp1 = InStr(2, SSS, "/") 'end of month temp2 = InStr(2, SSS, " ") 'right after year ' temp3 = InStr(temp1 + 1, SSS, "/") 'start of year ' SSS = " " + sep + Mid(SSS, temp3 + 1, temp2 - temp3) + sep + " " + Left(SSS, temp1) ' sep99 sep 7/ for july SSS1 = Left(SSS, temp1) SSS2 = Mid(SSS, temp2 - 3, 4) SSS3 = "" SSS4 = "" '09 JUNE 2002 SSS5 = "" SSS6 = "" SSS = "" KEEPS1 = SSS1 + "" KEEPS2 = SSS2 + "" KEEPS3 = SSS3 + "" KEEPS4 = SSS4 + "" '09 june 2002 KEEPS5 = SSS5 + "" KEEPS6 = SSS6 + "" SAVE_KEEPS1 = KEEPS1 + "" SAVE_KEEPS2 = KEEPS2 + "" SAVE_KEEPS3 = KEEPS3 + "" SAVE_KEEPS4 = KEEPS4 + "" '09 june 2002 SAVE_KEEPS5 = KEEPS5 + "" SAVE_KEEPS6 = KEEPS6 + "" inin = "M" 'maybe put the above changes in the MM below june 15/00 ' Context = "yes" ' Print "testing="; SSS1; "*"; SSS2; "*"; SSS3; "*" If debug_photo Then '12 october 2002 tt1 = InputBox("testing photo 4", , , 4400, 4500) 'TESTING ONLY End If GoTo input_990 End If If SSS = "MM" Then 'month of last find SSS = date_displayed temp1 = InStr(2, SSS, "/") 'end of month temp2 = InStr(2, SSS, " ") 'right after year temp3 = InStr(temp1 + 1, SSS, "/") 'start of year ' SSS = " " + sep + Mid(SSS, temp3 + 1, temp2 - temp3) + sep + " " + Left(SSS, temp1) ' sep99 sep 7/ for july SSS1 = Left(SSS, temp1) SSS2 = Mid(SSS, temp2 - 3, 4) SSS3 = "" SSS4 = "" '09 JUNE 2002 SSS5 = "" SSS6 = "" SSS = "" KEEPS1 = SSS1 + "" KEEPS2 = SSS2 + "" KEEPS3 = SSS3 + "" KEEPS4 = SSS4 + "" '09 june 2002 KEEPS5 = SSS5 + "" KEEPS6 = SSS6 + "" SAVE_KEEPS1 = KEEPS1 + "" SAVE_KEEPS2 = KEEPS2 + "" SAVE_KEEPS3 = KEEPS3 + "" SAVE_KEEPS4 = KEEPS4 + "" '09 june 2002 SAVE_KEEPS5 = KEEPS5 + "" SAVE_KEEPS6 = KEEPS6 + "" inin = "MM" GoTo input_990 End If Context = "no" 'june 26/99 what is with this line? 'june 26/99 If SSS = "-" Then Context = "yes" SSS = " " + sep + " " + sep + date_displayed SAVE_KEEPS1 = KEEPS1 + "" 'ALLOW FOR CONTEXT HILITE SAVE_KEEPS2 = KEEPS2 + "" 'june 26/99 SAVE_KEEPS3 = KEEPS3 + "" SAVE_KEEPS4 = KEEPS4 + "" '09 june 2002 SAVE_KEEPS5 = KEEPS5 + "" SAVE_KEEPS6 = KEEPS6 + "" End If 'use date found from previous search to get 'all data entered that day If SSS = "=" Then Context = "yes" SSS = date_displayed temp1 = InStr(SSS, "/") 'end of month temp2 = InStr(SSS, " ") 'right after year temp3 = InStr(temp1 + 1, SSS, "/") 'start of year SSS = " " + sep + Mid(SSS, temp3 + 1, temp2 - temp3) + sep + " " + Left(SSS, temp1) ' sep99 sep 7/ for july SAVE_KEEPS1 = KEEPS1 + "" 'ALLOW FOR CONTEXT HILITE SAVE_KEEPS2 = KEEPS2 + "" 'june 26/99 SAVE_KEEPS3 = KEEPS3 + "" SAVE_KEEPS4 = KEEPS4 + "" SAVE_KEEPS5 = KEEPS5 + "" SAVE_KEEPS6 = KEEPS6 + "" End If 'PARSE THE SSS STRING INTO PARTS SSS1 SSS2 SSS3 SSS4 SSS5 SSS6 line_700: i = InStr(SSS, " ") If i <> 0 Then SSS = Left(SSS, i) + Mid(SSS, i + 2) GoTo line_700 End If i = InStr(SSS, sep) SSS1 = SSS + "" s1len = Len(SSS1) inin = SSS + "" 'june 13/99 If i = 0 Then GoTo input_990 End If SSS1 = Left(SSS, i - 1) s1len = Len(SSS1) j = Len(SSS) SSS = Right(SSS, j - i) i = InStr(SSS, sep) SSS2 = SSS s2len = Len(SSS2) ' Print "testing="; SSS1; "*"; SSS2; "*"; SSS3; "*" If debug_photo Then '12 october 2002 tt1 = InputBox("testing photo 5", , , 4400, 4500) 'TESTING ONLY End If '09 june 2002 add 3 more elements here If i = 0 Then GoTo input_990 End If SSS2 = Left(SSS, i - 1) s2len = Len(SSS2) j = Len(SSS) SSS = Right(SSS, j - i) i = InStr(SSS, sep) SSS3 = SSS s3len = Len(SSS3) '--------------------------------------------- If i = 0 Then GoTo input_990 End If SSS3 = Left(SSS, i - 1) s3len = Len(SSS3) j = Len(SSS) SSS = Right(SSS, j - i) i = InStr(SSS, sep) SSS4 = SSS s4len = Len(SSS4) '======================================================== If i = 0 Then GoTo input_990 End If SSS4 = Left(SSS, i - 1) s4len = Len(SSS4) j = Len(SSS) SSS = Right(SSS, j - i) i = InStr(SSS, sep) SSS5 = SSS s5len = Len(SSS5) '---------------------------------------------- If i = 0 Then GoTo input_990 End If SSS5 = Left(SSS, i - 1) s5len = Len(SSS5) j = Len(SSS) SSS6 = Right(SSS, j - i) s6len = Len(SSS6) input_990: If ss_only = "YES" And p2p2 = "SS" Then ttt = "SS" + " " + SSS1 + " " + SSS2 + " " + SSS3 + " " + SSS4 + " " + SSS5 + " " + SSS6 ss_only = "NO" GoTo auto_p2 End If '07 december 2002 tot_cnt = 0 GoSub line_14500 'check for imbedded spaces in search strings 'january 19 2001 '*********************************************** 'Major input line for the sequential file read '*********************************************** input_1000: 'INPUT HERE save_line = "1000" 'for error handling slomo = False '14 January 2004 motion_yn = "NO" '03 September 2004 If SAVE_ttt = "C" Then Context_cnt = Context_cnt + 1 'aug 08/99 If Context_cnt > MAX_CNT Then Context_cnt = 1 End If Context_text(Context_cnt) = ccc + "" End If 'aug 08/99 save last 10 lines at least 'the following code along with the form keypreview set to true 'should enable escape similar to ctrl/c on the vax 'endscript and keydown subroutines at the end also Dec 02/99 If zzz_cnt Mod 1000 = 0 Then DoEvents End If If Escape Then Escape = False GoTo End_32000 End If If Picture_Search = "YES" Then Previous_line = ooo 'keep this to search for XXX. End If 'march 31/00 'main input file read here '************************************************* 'main input file data read ' * * * I N P U T * * * '************************************************* input_1000a: Line Input #OutFile, aaa ' frmproj2.Caption = " testing=" + Left(aaa, 40) + "=" '26 November 2004 '20 November 2004 maybe the line below needs setting as I return here a lot... ***vip*** todo check out sometime ' save_line = "1000" 'for error handling 20 November 2004 ' line_pos = 0 'november 22 2000 january 05 2001 zzz_cnt = zzz_cnt + 1 If rand Then If zzz_cnt < rand_no Then GoTo input_1000a '18 august 2002 '03 August 2003 below is where to change the 2 to what ever the range is for random by group display 'ie if there are 6 videos in the group the number should be 12 or 13 below??? ***vip*** todo '06 September 2004 if random and a text search just do random on first get then sequential If p2p2 = "C" Or p2p2 = "S" Or p2p2 = "F" Then rand = False GoTo input_1000a End If '06 September 2004 If zzz_cnt > rand_no + 2 Then 'this may display 2 in a row but that is ok 'refresh, #outfile need to be able to reset the file at beginning Close #OutFile II = DoEvents OutFile = FreeFile Open TheFile For Input As #OutFile II = DoEvents 'yield to operating system rand_no = Int(rand_cnt * Rnd + 1) zzz_cnt = 0 GoTo input_1000a End If End If ' If hi_lites <> "YES" Then line_match = "" 'november 21 2000 If encript = "MYSTUF" Then GoSub line_29400 ' If zzz_cnt Mod 10000 = 0 Then ' DoEvents ' Print "searching "; zzz_cnt ' End If End If If skip_info <> "" Then If InStr(aaa, skip_info) <> 0 Then GoTo input_1000a End If End If 'november 14 2000 this check takes 1/2 second on 190,000 records 'ie 9.67 to 10.20 in the quickie mode for the if skip_info <> "" 190,000 times If prompt2 <> "Q" Then GoTo input_1000b 'Quickie search fix End If ' aaa = UCase(aaa) 'december 8 testing ucased timing 'info in testing the above line it took over 2 times as much 'time to do the search with just including the above statement' 'my outmail.txt search went from 14.45 seconds to 34.45 secs If uppercase = "Y" Then ooo = aaa + "" aaa = UCase(aaa) 'december 8 2000 End If If InStr(aaa, SSS1) = 0 Then GoTo input_1000a End If If SSS2 = "" Then GoTo input_1000aa End If If InStr(aaa, SSS2) = 0 Then GoTo input_1000a End If If SSS3 = "" Then GoTo input_1000aa End If If InStr(aaa, SSS3) = 0 Then GoTo input_1000a End If 'add in sss4 thru sss6 09 june 2002 If SSS4 = "" Then GoTo input_1000aa End If If InStr(aaa, SSS4) = 0 Then GoTo input_1000a End If If SSS5 = "" Then GoTo input_1000aa End If If InStr(aaa, SSS5) = 0 Then GoTo input_1000a End If If SSS6 = "" Then GoTo input_1000aa End If If InStr(aaa, SSS6) = 0 Then GoTo input_1000a End If ' If InStr(aaa, qqq) = 0 Then ' GoTo input_1000a ' End If 'october 21 2000 input_1000aa: If uppercase = "Y" Then aaa = ooo 'december 8 2000 previous_count = previous_count + 1 'october 22 2000 If previous_count > 100 Then previous_count = 1 End If previous_picture(previous_count) = zzz_cnt input_1000b: 'december 11 2000 the lines from here to input_1000bb 'december 15 2000 testing stuff below ' If show_files_yn Then '24 december 2002 ' xtemp = InputBox("DOUG " + show_files+" "+aaa, , , 4400, 4500) 'TESTING ONLY II = InStr(aaa, " append start") 'other appends have -append start If II <> 0 Then show_files = Left(aaa, II - 1) End If End If '24 december 2002 xtemp = "" ' xtemp = "test=" If xtemp <> "" Then III = Len(aaa) 'december 17 2000 If III > 10 Then III = 10 For II = 1 To III xtemp = xtemp + CStr(Asc(Mid(aaa, II, 1))) + " " Next II aaa = aaa + xtemp + CStr(Len(aaa)) End If 'end of test section If emailsea <> "Y" Then GoTo line_1001 If Right(aaa, 3) = "=20" Then aaa = Left(aaa, Len(aaa) - 3) End If 'december 18 2000 whatever the deal is with the "-20 " get rid of it 'december 17 2000 if more than 1 ascii value < 10 then mbx start of new mail message If mbxyes <> "Y" Then GoTo nombx1000 'december 17 2000 If Len(aaa) = 0 And mbxi = 0 Then GoTo input_1000a 'december 18 2000 If mbxi = 0 Then III = InStr(aaa, "From:") 'december 17 2000 If mbxi = 0 And III <> 0 Then aaa = Right(aaa, Len(aaa) - III + 1) dateskip = "" 'december 19 20002 mbxi = 1 End If If mbxi = 0 Then GoTo input_1000a 'december 18 2000 nombx1000: 'december 15 2000 added and in test mode If InStr(aaa, "Reply-To") <> 0 And mbxyes = "Y" Then dateskip = "" boundarystr = "" boundarycnt = 0 aaa = "========================= email start =========================" GoTo input_1000bb 'need to print the seperator above End If If InStr(aaa, "Return-Path") <> 0 Then GoTo input_1000a End If 'december 20 2000 If InStr(aaa, "Return-Path") <> 0 Then dateskip = "" boundarystr = "" boundarycnt = 0 aaa = "========================= email start =========================" GoTo input_1000bb 'need to print the seperator above End If If InStr(aaa, "From - ") <> 0 Then dateskip = "Y" boundarystr = "" boundarycnt = 0 aaa = "========================= email start =========================" GoTo input_1000bb 'need to print the seperator above End If If InStr(aaa, "From ????") <> 0 Then dateskip = "Y" boundarystr = "" boundarycnt = 0 aaa = "========================= email start =========================" GoTo input_1000bb 'need to print the seperator above End If If dateskip = "F" Then dateskip = "Y" boundarystr = "" boundarycnt = 0 aaa = "========================= email start =========================" GoTo input_1000bb 'need to print the seperator above End If If InStr(aaa, "Date: ") <> 0 And dateskip = "Y" Then dateskip = "" GoTo input_1000bb End If If InStr(aaa, "From: ") <> 0 And dateskip = "Y" Then dateskip = "" GoTo input_1000bb End If If dateskip = "Y" Then GoTo input_1000a 'december 12 2000 If InStr(aaa, "Reply-To") <> 0 Then GoTo input_1000a If InStr(aaa, "To: ") <> 0 Then GoTo input_1000bb If InStr(aaa, "Subject: ") <> 0 Then GoTo input_1000bb ' If InStr(aaa, "boundary=") <> 0 Then february 28 2001 If InStr(aaa, "boundary=""") <> 0 Then III = InStr(aaa, "boundary=") II = InStr(III + 10, aaa, """") 'quote mark search double quote boundarystr = Mid(aaa, III + 10, II - III - 10) boundarycnt = 0 'december 18 2000 ' tt1 = InputBox(boundarystr + " " + CStr(boundarycnt), , , 4400, 4500) 'TESTING ONLY GoTo input_1000a End If If Len(boundarystr) > 2 And InStr(aaa, boundarystr) <> 0 Then boundarycnt = boundarycnt + 1 GoTo input_1000a End If If boundarycnt = 0 And Len(boundarystr) > 2 Then GoTo input_1000a If boundarycnt > 1 Then GoTo input_1000a 'december 30 2000 skip a few of the odd characters that linger If mbxyes = "Y" And Len(aaa) < 6 Then III = Len(aaa) 'december 17 2000 For II = 1 To III If Asc(Mid(aaa, II, 1)) > 126 Then GoTo input_1000a If Asc(Mid(aaa, II, 1)) < 9 Then GoTo input_1000a Next II End If 'december 30 2000 end of code input_1000bb: If InStr(aaa, "= email start =") <> 0 Then tot_s1 = tot_s1 + 1 'january 28 2001 If InStr(aaa, "Errors-to:") <> 0 Then GoTo input_1000a If InStr(aaa, "Mime-Version:") <> 0 Then GoTo input_1000a If InStr(aaa, "Reply-to:") <> 0 Then GoTo input_1000a If InStr(aaa, "User-Agent:") <> 0 Then GoTo input_1000a If InStr(aaa, "X-Accept-Language:") <> 0 Then GoTo input_1000a If InStr(aaa, "Importance:") <> 0 Then GoTo input_1000a If InStr(aaa, "X-Mozilla") <> 0 Then GoTo input_1000a If InStr(aaa, "References:") <> 0 Then GoTo input_1000a If InStr(aaa, "X-Mailer:") <> 0 Then GoTo input_1000a If InStr(aaa, "X-MSMail-") <> 0 Then GoTo input_1000a If InStr(aaa, "X-MimeOLE") <> 0 Then GoTo input_1000a If InStr(aaa, "X-Priority:") <> 0 Then GoTo input_1000a If InStr(aaa, "MIME-V") <> 0 Then GoTo input_1000a If InStr(aaa, "MIME format.") <> 0 Then GoTo input_1000a If InStr(aaa, "Message-ID") <> 0 Then GoTo input_1000a If InStr(aaa, "Message-Id: ") <> 0 Then GoTo input_1000a If InStr(aaa, "Content-T") <> 0 Then GoTo input_1000a If InStr(aaa, "charset=") <> 0 Then GoTo input_1000a 'the characters "photo" must exist for this to match up line_1001: 'december 25/2000 If Picture_Search = "YES" Then ' If InStr(UCase(aaa), "PHOTO") = 0 Then 'don't skip if search is for XXX. ooo = aaa + "" GoTo input_1000 End If End If 'march 31/00 '25 July 2003 If temp_sec <> -1 And temp_sec <> delay_sec Then If temp_sec <> 0 And temp_sec <> -1 And temp_sec <> delay_sec Then delay_sec = temp_sec ' If delay_sec < 0.3 Then ' tt1 = InputBox("testing=" + Format(delay_sec, "###0.000") + "=", , , 4400, 4500) 'TESTING ONLY ' End If '25 July 2003 End If 'march 14 2001 If Picture_Search = "YES" Then ' III = InStr(UCase(aaa), " WAIT=") line_delay_sec = 0 '19 July 2003 Ver=1.07T '22 september 2003 If III <> 0 Then If III <> 0 And thumb_nail <> "YES" Then temp_sec = delay_sec II = InStr(III + 5, aaa + " ", " ") 'make sure there is a trailing space here xtemp = Mid(aaa, III + 6, II - III - 6) ' tt1 = InputBox("testing=" + xtemp + "=", , , 4400, 4500) 'TESTING ONLY delay_sec = Val(xtemp) line_delay_sec = delay_sec '19 July 2003 Ver=1.07T End If '16 November 2003 III = InStr(UCase(aaa), " SPEED=") line_speed = 1000 ' play_speed = line_speed '13 May 2004 (see other setting too) If III <> 0 Then ' temp_sec = delay_sec II = InStr(III + 6, aaa + " ", " ") 'make sure there is a trailing space here xtemp = Mid(aaa, III + 7, II - III - 7) ' tt1 = InputBox("testing=" + xtemp + "=", , , 4400, 4500) 'TESTING ONLY line_speed = Val(xtemp) play_speed = line_speed End If '16 November 2003 '24 September 2003 add the line_freeze_sec stuff III = InStr(UCase(aaa), " FREEZE=") Line_freeze_sec = 0 If III <> 0 Then temp_sec = delay_sec II = InStr(III + 7, aaa + " ", " ") 'make sure there is a trailing space here xtemp = Mid(aaa, III + 8, II - III - 8) ' tt1 = InputBox("testing=" + xtemp + "=", , , 4400, 4500) 'TESTING ONLY Line_freeze_sec = Val(xtemp) End If '24 September 2003 end of line_freeze_sec stuff '22 March 2004 line_start_point = 0 '19 July 2003 Ver=1.07T If thumb_nail <> "YES" Then line_start_point = 0 '22 March 2004 If thumb_nail <> "YES" Then line_start_point = 10 '11 March 2007 III = InStr(UCase(aaa), " START==") '19 July 2003 Ver=1.07T If III <> 0 Then II = InStr(III + 7, aaa + " ", " ") 'make sure there is a trailing space here xtemp = Mid(aaa, III + 8, II - III - 8) line_start_point = Val(xtemp) End If End If 'march 14 2001 'replace any tabs with 4 spaces right here save_line = "1002" 'for error handling line_1002: '07 november 2002 comment out the do_tab below for now ' If do_tab Then '05 october 2002 (no spaces in search string) tt = InStr(aaa, Chr(9)) 'check for tabs If tt = 0 Then GoTo line_1008 End If 'change any tabs to 4 spaces aaa = Left(aaa, tt - 1) + " " + Mid(aaa, tt + 1) GoTo line_1002 '07 november 2002 End If '05 october 2002 line_1008: tt = InStr(aaa, Chr(10)) 'check for line feed january 22 2001 If tt = 0 Then GoTo line_1008d End If 'change any line feeds to nothings aaa = Left(aaa, tt - 1) + " " + Mid(aaa, tt + 1) ooo = Left(ooo, tt - 1) + " " + Mid(ooo, tt + 1) GoTo line_1008 line_1008d: ooo = aaa + "" 'save the original chr upper/lower 'original input line saved save_line = "1008" 'for error handling ' If Len(aaa) > zzz_len Then ' zzz_len = Len(aaa) ' long_line = Left(aaa, 20) ' maybe fix it in editor? ' End If zzz_chrs = zzz_chrs + Len(ooo) + 2 'the cr/lf characters. If printed <> "YES" And printed_cnt Mod MAX_CNT * 10000 = 0 Then Cls End If 'may 10/00 If printed <> "YES" And printed_cnt Mod 10000 = 0 Then DoEvents 'december 06 2001 Print "reading "; zzz_cnt End If 'may 10/00 printed_cnt = printed_cnt + 1 'may 10/00 ******************************** old_line = " " + aaa + " " '25 March 2003 part of version ver=1.02b If uppercase = "Y" Or sscreen_saver = "Y" Then aaa = " " + UCase(aaa) + " " Else aaa = " " + aaa + " " End If '01 october 2002 no need to to put uppercase if all numeric ooo = " " + ooo + " " 'just to match with aaa 'december 8 2000 If prompt2 = "Q" Then If prompt2 = "Q" And uppercase = "N" Then aaa = ooo + "" End If 'no upper case switch for quicky search lll = aaa + "" 'used to show where "P1" matched on in e to exit prompt ccc = ooo + "" 'aug 08/99 'no show logic 'might want to have the logic for no-show changed here somewhat 'ie if anything other that P1 or P then the noshow elements should 'be cleared (ie count set to 0) etc if "no-show" not the first element 'this would allow for the replacement of the skip and the complete removal 'in the text display of anything that shouldn't be shown 'these notes were done december 30 2000 'may want the no-show words replaced with "******" so the search will fail 'todo **vip** at some point in time this is censorship??? ' If prompt2 <> "P1" And prompt2 <> "P" Then GoTo line_1009_a 'december 25 2000 If extract_yes = "YES" Then GoTo line_1009_a 'january 03 2001 If encript <> "" Then GoTo line_1009_a 'january 03 2001 ' tt1 = InputBox("doshow logic " + aaa, , , 4400, 4500) 'TESTING ONLY If InStr(aaa, "DOSHOW") <> 0 Then GoTo line_1009_a '18 August 2003 For II = 1 To nocount ' If zzz_cnt > 80 Then ' Print "noshow(a)="; "*"; zzz_cnt; "*"; noshow(II); "*"; prompt2; "*"; aaa; nocount ' this one can go on and on so allow for an exit here if bad entry If debug_photo Then '12 october 2002 tt1 = InputBox("testing photo 6", , , 4400, 4500) 'TESTING ONLY If Len(tt1) > 0 Then debug_photo = False 'allow for an out here End If ' End If 'testing only january 27 2001 If Len(noshow(II)) < 1 Then GoTo line_1009 End If If (prompt2 = "P1" Or prompt2 = "P") And InStr(aaa, noshow(II)) <> 0 Then GoTo input_1000 'skip if noshow found in line End If If prompt2 = "SS" And InStr(aaa, noshow(II)) <> 0 Then GoTo input_1000 'skip if noshow in screen saver also january 27 2001 End If tt = 1 'january 04 2001 'the following keeps these words from showing in text display?? line_1008m: III = InStr(tt, aaa, noshow(II)) 'january 03 2001 If III = 0 Then GoTo line_1009 'january 03 2001 tt = III + 1 JJ = Len(noshow(II)) 'january 03 2001 ooo = Left(ooo, III - 1) + String(JJ, "*") + Mid(ooo, III + JJ) 'january 03 2001 GoTo line_1008m 'the mid statement without the length works the same as the vax basic right statement vms stuff line_1009: Next II line_1009_a: 'december 25 2000 'screensaver logic ' Print "screensave(?)="; "*"; screensave(1); "*"; aaa; "1"; sscreen_saver; prompt2 ' Print "screensave(?)="; "*"; screensave(screencount); "*"; aaa; screencount; sscreen_saver; prompt2 ' Print sscreen_saver ' tt1 = InputBox("testing screen saver logic", , , 4400, 4500) 'TESTING ONLY ' If tt1 = "X" Or tt1 = "x" Then ' GoTo End_32000 ' End If 'testing only 'if no screen saver jump around this logic '28 APRIL 2002 If sscreen_saver <> "Y" Then GoTo line_1009b If sscreen_saver <> "Y" Or sscreen_saver_ww = "YES" Then GoTo line_1009b For II = 1 To screencount If Len(screensave(II)) < 1 Then GoTo input_1000 End If If InStr(aaa, screensave(II)) <> 0 Then SSS1 = screensave(II) ' inactive ss_search = "PHOTO" ss_search = screensave(II) ' Print "inlogic="; "*"; screensave(screencount); "*"; aaa; screencount; sscreen_saver; prompt2 ' tt1 = InputBox("testing screen saver logic", , , 4400, 4500) 'TESTING ONLY GoTo display_all_2000 'show if screensave found in line End If line_1009a: Next II GoTo input_1000 'october 24 2000 screen saver fix line_1009b: If inin = "A" Or inin = "ALL" Then GoTo display_all_2000 End If 'on flash display to screen If SAVE_ttt = "F" Then GoTo display_all_2000 End If If SAVE_ttt = "C" And hi_lites = "YES" Then GoTo display_all_2000 'aug 08/99 End If If inin = "M" Or inin = "MM" Then If L