Occassionally, Alpha will tell you a file is open and/or in use by someone. Maybe when programming, when rebuilding indexes, when opening a file in exclusive mode, or when compacting the adb. And closing and reopening the ADB doesn't help. Nor does rebooting the computer. This is because Alpha often uses the registry for keeping track of open tables and files. And they don't get removed and/or updated properly - especially when there is a crash, or Alpha throws an error or programming code throws an error.
I am including 3 functions for keeping Alpha clean. The first two were graciously done for me by Stan Mathews, which clean the registry; and the last was done many years ago by Cal Lochlin, which keeps temporary files clean.
As with any code, use this at your own risk. I am currently using it for one client with a shadowed ADB, and another with T/S.
function clean_tables as L()
dim user_data.foo as C
User_Data.foo = ""
dim cont as C
dim rslt_cont as C
dim cont_ln as C
dim ln as C
:registry.load_settings("Tables",User_Data)
cont = property_to_string(user_data)
for each fooc in cont
SELECT
CASE "<DBF" $ fooc
ln = stritran(fooc,"<DBF",".DBF")
cont_ln = extract_string(ln,"<","<",1)
rslt_cont = rslt_cont + cont_ln + crlf()
CASE "<ALB" $ fooc
ln = stritran(fooc,"<ALB",".ALB")
cont_ln = extract_string(ln,"<","<",1)
rslt_cont = rslt_cont + cont_ln + crlf()
CASE "<SET" $ fooc
ln = stritran(fooc,"<SET",".SET")
cont_ln = extract_string(ln,"<","<",1)
rslt_cont = rslt_cont + cont_ln + crlf()
CASE "<DDD" $ fooc
ln = stritran(fooc,"<DDD",".DDD")
cont_ln = extract_string(ln,"<","<",1)
rslt_cont = rslt_cont + cont_ln + crlf()
END SELECT
next
for each foox in rslt_cont
registry.drop_settings("Tables\\"+foox)
next
registry.drop_settings("Tables")
end function
'**********************************************
on error goto errors
function clean_indexes as L()
dim user_data.foo as C
User_Data.foo = ""
dim cont as C
dim rslt_cont as C
dim cont_ln as C
dim ln as C
:registry.load_settings("INDX",User_Data)
cont = property_to_string(user_data)
rslt_cont = ""
cont_ln = ""
FOR each fooc in cont
SELECT
CASE "<DBF" $ fooc
IF "-" $ fooc
keyn = extract_string(fooc,"<","<",1)
tblno = extract_string(fooc,";","<",1)
ln = strtran(fooc,"<DBF",".DBF")
cont_ln = extract_string(ln,"<","<",1)
rslt_cont = rslt_cont + cont_ln + crlf()
ELSE
tblno = increment_value(tblno)
cont_ln = keyn+".dbf"+";"+tblno
rslt_cont = rslt_cont + cont_ln + crlf()
END IF
CASE "<ALB" $ fooc
IF "-" $ fooc
keyn = extract_string(fooc,"<","<",1)
tblno = extract_string(fooc,";","<",1)
ln = strtran(fooc,"<ALB",".ALB")
cont_ln = extract_string(ln,"<","<",1)
rslt_cont = rslt_cont + cont_ln + crlf()
ELSE
tblno = increment_value(tblno)
cont_ln = keyn+".alb"+";"+tblno
rslt_cont = rslt_cont + cont_ln + crlf()
END IF
CASE "<SET" $ fooc
IF "-" $ fooc
keyn = extract_string(fooc,"<","<",1)
tblno = extract_string(fooc,";","<",1)
ln = strtran(fooc,"<SET",".SET")
cont_ln = extract_string(ln,"<","<",1)
rslt_cont = rslt_cont + cont_ln + crlf()
ELSE
tblno = increment_value(tblno)
cont_ln = keyn+".set"+";"+tblno
rslt_cont = rslt_cont + cont_ln + crlf()
END IF
CASE "<DDD" $ fooc
IF "-" $ fooc
keyn = extract_string(fooc,"<","<",1)
tblno = extract_string(fooc,";","<",1)
ln = strtran(fooc,"<DDD",".DDD")
cont_ln = extract_string(ln,"<","<",1)
rslt_cont = rslt_cont + cont_ln + crlf()
ELSE
tblno = increment_value(tblno)
cont_ln = keyn+".ddd"+";"+tblno
rslt_cont = rslt_cont + cont_ln + crlf()
END IF
END SELECT
next
FOR each foox in rslt_cont
registry.drop_settings("INDX\\"+foox)
next
registry.drop_settings("INDX")
end function
end
errors:
err_msg = error_text_get(error_code_get())
line = error_line_number_get()
script = error_script_get()
ui_msg_box("Error", err_msg+" Error occurred at line "+alltrim(str(line,4,0))+ " in script: "+script)
end
'**************************************
function cleanit as L()
DIM path[10] as c
path[1] = a5.get_path() + chr(92)
path[2] = a5.get_private_path() + chr(92)
pcount = 2
IF a5.get_private_path() <> a5.get_exe_path()
path[3] = a5.get_exe_path() + chr(92)
pcount = 3
END IF
fcount = 0
FOR x = 1 to pcount
'type_of_files = 0 + FILE_FIND_ARCHIVE + FILE_FIND_READONLY + FILE_FIND_HIDDEN
'dfiles = filefind.first( path[x] + "$$*.*", type_of_files )
dfiles = filefind.first( path[x] + "$$*.*", FILE_FIND_NOT_DIRECTORY )
WHILE .not.dfiles.eof()
fname = dfiles.name() '*** GET THE FILE NAME.
ON ERROR goto Continue_next '*** FIND OUT IF THE FILE IS LOCKED.
fp = file.open( fname, file_rw_exclusive )
ON ERROR goto 0
fp.close() '*** FILE IS NOT LOCKED SO CLOSE IT AND REMOVE IT.
file.remove( fname )
fcount = fcount + 1
'---------------
Continue_next:
'---------------
ON ERROR goto 0
dfiles.next() '*** GET NEXT FILE IN LIST.
statusbar.robot()
END WHILE
NEXT
end function
I am including 3 functions for keeping Alpha clean. The first two were graciously done for me by Stan Mathews, which clean the registry; and the last was done many years ago by Cal Lochlin, which keeps temporary files clean.
As with any code, use this at your own risk. I am currently using it for one client with a shadowed ADB, and another with T/S.
function clean_tables as L()
dim user_data.foo as C
User_Data.foo = ""
dim cont as C
dim rslt_cont as C
dim cont_ln as C
dim ln as C
:registry.load_settings("Tables",User_Data)
cont = property_to_string(user_data)
for each fooc in cont
SELECT
CASE "<DBF" $ fooc
ln = stritran(fooc,"<DBF",".DBF")
cont_ln = extract_string(ln,"<","<",1)
rslt_cont = rslt_cont + cont_ln + crlf()
CASE "<ALB" $ fooc
ln = stritran(fooc,"<ALB",".ALB")
cont_ln = extract_string(ln,"<","<",1)
rslt_cont = rslt_cont + cont_ln + crlf()
CASE "<SET" $ fooc
ln = stritran(fooc,"<SET",".SET")
cont_ln = extract_string(ln,"<","<",1)
rslt_cont = rslt_cont + cont_ln + crlf()
CASE "<DDD" $ fooc
ln = stritran(fooc,"<DDD",".DDD")
cont_ln = extract_string(ln,"<","<",1)
rslt_cont = rslt_cont + cont_ln + crlf()
END SELECT
next
for each foox in rslt_cont
registry.drop_settings("Tables\\"+foox)
next
registry.drop_settings("Tables")
end function
'**********************************************
on error goto errors
function clean_indexes as L()
dim user_data.foo as C
User_Data.foo = ""
dim cont as C
dim rslt_cont as C
dim cont_ln as C
dim ln as C
:registry.load_settings("INDX",User_Data)
cont = property_to_string(user_data)
rslt_cont = ""
cont_ln = ""
FOR each fooc in cont
SELECT
CASE "<DBF" $ fooc
IF "-" $ fooc
keyn = extract_string(fooc,"<","<",1)
tblno = extract_string(fooc,";","<",1)
ln = strtran(fooc,"<DBF",".DBF")
cont_ln = extract_string(ln,"<","<",1)
rslt_cont = rslt_cont + cont_ln + crlf()
ELSE
tblno = increment_value(tblno)
cont_ln = keyn+".dbf"+";"+tblno
rslt_cont = rslt_cont + cont_ln + crlf()
END IF
CASE "<ALB" $ fooc
IF "-" $ fooc
keyn = extract_string(fooc,"<","<",1)
tblno = extract_string(fooc,";","<",1)
ln = strtran(fooc,"<ALB",".ALB")
cont_ln = extract_string(ln,"<","<",1)
rslt_cont = rslt_cont + cont_ln + crlf()
ELSE
tblno = increment_value(tblno)
cont_ln = keyn+".alb"+";"+tblno
rslt_cont = rslt_cont + cont_ln + crlf()
END IF
CASE "<SET" $ fooc
IF "-" $ fooc
keyn = extract_string(fooc,"<","<",1)
tblno = extract_string(fooc,";","<",1)
ln = strtran(fooc,"<SET",".SET")
cont_ln = extract_string(ln,"<","<",1)
rslt_cont = rslt_cont + cont_ln + crlf()
ELSE
tblno = increment_value(tblno)
cont_ln = keyn+".set"+";"+tblno
rslt_cont = rslt_cont + cont_ln + crlf()
END IF
CASE "<DDD" $ fooc
IF "-" $ fooc
keyn = extract_string(fooc,"<","<",1)
tblno = extract_string(fooc,";","<",1)
ln = strtran(fooc,"<DDD",".DDD")
cont_ln = extract_string(ln,"<","<",1)
rslt_cont = rslt_cont + cont_ln + crlf()
ELSE
tblno = increment_value(tblno)
cont_ln = keyn+".ddd"+";"+tblno
rslt_cont = rslt_cont + cont_ln + crlf()
END IF
END SELECT
next
FOR each foox in rslt_cont
registry.drop_settings("INDX\\"+foox)
next
registry.drop_settings("INDX")
end function
end
errors:
err_msg = error_text_get(error_code_get())
line = error_line_number_get()
script = error_script_get()
ui_msg_box("Error", err_msg+" Error occurred at line "+alltrim(str(line,4,0))+ " in script: "+script)
end
'**************************************
function cleanit as L()
DIM path[10] as c
path[1] = a5.get_path() + chr(92)
path[2] = a5.get_private_path() + chr(92)
pcount = 2
IF a5.get_private_path() <> a5.get_exe_path()
path[3] = a5.get_exe_path() + chr(92)
pcount = 3
END IF
fcount = 0
FOR x = 1 to pcount
'type_of_files = 0 + FILE_FIND_ARCHIVE + FILE_FIND_READONLY + FILE_FIND_HIDDEN
'dfiles = filefind.first( path[x] + "$$*.*", type_of_files )
dfiles = filefind.first( path[x] + "$$*.*", FILE_FIND_NOT_DIRECTORY )
WHILE .not.dfiles.eof()
fname = dfiles.name() '*** GET THE FILE NAME.
ON ERROR goto Continue_next '*** FIND OUT IF THE FILE IS LOCKED.
fp = file.open( fname, file_rw_exclusive )
ON ERROR goto 0
fp.close() '*** FILE IS NOT LOCKED SO CLOSE IT AND REMOVE IT.
file.remove( fname )
fcount = fcount + 1
'---------------
Continue_next:
'---------------
ON ERROR goto 0
dfiles.next() '*** GET NEXT FILE IN LIST.
statusbar.robot()
END WHILE
NEXT
end function
Comment