Attribute VB_Name = "SECURITY_bas"
OPTION Explicit
Public CONST ApplicationName = "MC-SECURITY"
Public DirectoryForApplication AS STRING
Public SelectedLanguage AS STRING
Public CurrentLanguage AS INTEGER
Public SaveTitleForm AS STRING
Public FileToUse AS STRING
Public SERIALDATA AS tagSERIALDATA
SUB FileProcessAdd()
DIM ErrCode AS INTEGER
DIM WasSerial AS INTEGER
' get the full name to use
FileToUse = GetFileToUse()
' if no file selected, stop
IF (LEN(FileToUse) = 0) THEN EXIT SUB
' check if file is serialized
WasSerial = cIsSerial(FileToUse)
' format the serial number field
frmSerialization.SerNumber.Text = VAL(frmSerialization.SerNumber.Text)
' set the serialization info from fields
SERIALDATA.Description1 = frmSerialization.SerPart1.Text
SERIALDATA.Description2 = frmSerialization.SerPart2.Text
SERIALDATA.Number = frmSerialization.SerNumber.Text
' put the serialization info
ErrCode = cSerialPut(FileToUse, SERIALDATA)
' check if file was been serialized
SELECT CASE WasSerial
CASE True
' no, display the message
CALL MessageDisplay("3", FileToUse)
CASE False
' yes, display the message
CALL MessageDisplay("2", FileToUse)
CASE ELSE
' error
CALL MessageDisplay("6", FileToUse)
END SELECT
END SUB
SUB FileProcessChange()
DIM ErrCode AS INTEGER
' get the full name to use
FileToUse = GetFileToUse()
' if no file selected, stop
IF (LEN(FileToUse) = 0) THEN EXIT SUB
' check if file is serialized
IF (cIsSerial(FileToUse) = 0) THEN
' no, display error
CALL MessageDisplay("1", FileToUse)
ELSE
' yes, add 1 to serial number
ErrCode = cSerialInc(FileToUse, 1)
' read the serialization info
ErrCode = cSerialGet(FileToUse, SERIALDATA)
' set the serialization info on fields
frmSerialization.SerPart1.Text = SERIALDATA.Description1
frmSerialization.SerPart2.Text = SERIALDATA.Description2
frmSerialization.SerNumber.Text = SERIALDATA.Number
' check the serial number, for example MOD 10
IF ((SERIALDATA.Number MOD 10) = 0) THEN
' yes, modulo 10, display message
CALL MessageDisplay("4", FileToUse)
END IF
END IF
END SUB
SUB FileProcessRead()
DIM ErrCode AS INTEGER
' get the full name to use
FileToUse = GetFileToUse()
' if no file selected, stop
IF (LEN(FileToUse) = 0) THEN EXIT SUB
' check if file is serialized
IF (cIsSerial(FileToUse) = 0) THEN
' no, display error
CALL MessageDisplay("1", FileToUse)
ELSE
' yes, display the serialization info
ErrCode = cSerialGet(FileToUse, SERIALDATA)
' set the serialization info on fields
frmSerialization.SerPart1.Text = SERIALDATA.Description1
frmSerialization.SerPart2.Text = SERIALDATA.Description2
frmSerialization.SerNumber.Text = SERIALDATA.Number
END IF
END SUB
SUB FileProcessRemove()
DIM ErrCode AS INTEGER
' get the full name to use
FileToUse = GetFileToUse()
' if no file selected, stop
IF (LEN(FileToUse) = 0) THEN EXIT SUB
' check if file is serialized
IF (cIsSerial(FileToUse) = 0) THEN
' no, display error
CALL MessageDisplay("1", FileToUse)
ELSE
' yes, remove the serialization info
ErrCode = cSerialRmv(FileToUse)
' display remove message
CALL MessageDisplay("5", FileToUse)
END IF
END SUB
FUNCTION GetFileToUse() AS STRING
' check if a file has been selected
IF (frmSerialization.File1.ListIndex >= 0) THEN
' yes, form the full name
GetFileToUse = frmSerialization.File1.Path + "\" + frmSerialization.File1.LIST(frmSerialization.File1.ListIndex)
ELSE
CALL MessageDisplay("0", "")
' no, return empty
GetFileToUse = ""
END IF
END FUNCTION
SUB Loader()
DoEvents
' some initializations
DirectoryForApplication = App.Path + "\"
' save the caption of this form
SaveTitleForm = frmSerialization.Caption
END SUB
SUB MessageDisplay(TextOrder AS STRING, InsertText AS STRING)
' display a multi-language message box, message are centered
' and a timeout of 30 seconds is displayed.
MsgBox ReadText(TextOrder, InsertText), vbOKOnly, SaveTitleForm
frmSerialization.ZOrder 0
END SUB
FUNCTION ReadText(TextOrder AS STRING, InsertText AS STRING) AS STRING
DIM i AS INTEGER
DIM n AS INTEGER
DIM Tmp AS STRING
DIM BasisText AS STRING
SELECT CASE TextOrder
CASE "0": BasisText = "You must select a file !"
CASE "1": BasisText = "File '~' is not a serialized file !"
CASE "2": BasisText = "File '~' is now serialized."
CASE "3": BasisText = "File '~' was serialized.??Serialization has been updated."
CASE "4": BasisText = "Message sample.??You've tried this program more than 10 uses.??Register this program.??Message sample."
CASE "5": BasisText = "Serialization information on file '~' has been removed."
CASE "6": BasisText = "Error when accessing the file '~'."
END SELECT
' insert some text if any
n = INSTR(BasisText, "~")
IF (n > 0) THEN
Tmp = LEFT$(BasisText, n - 1) + InsertText + MID$(BasisText, n + 1)
ELSE
Tmp = BasisText
END IF
' change all ? to make a CR
n = 0
n = INSTR(n + 1, Tmp, "?")
DO WHILE (n > 0)
MID$(Tmp, n, 1) = vbCr
n = INSTR(n + 1, Tmp, "?")
LOOP
ReadText = Tmp
END FUNCTION
Public FUNCTION REMoveNull(sStr As String) As String
DIM i AS INTEGER
DIM n AS INTEGER
DIM s AS STRING
s = sStr
n = LEN(s)
FOR i = 1 TO n
IF (ASC(MID$(s, i, 1)) = 0) THEN MID$(s, i, 1) = " "
NEXT i
REMoveNull = s
END FUNCTION