*/
Love this site? Hate it? Leave us some comments.
*/

View \MCSECURE.BAS

MC-SECURITY (16/32 Bit) for VB4.0

Submitted By: Unknown
Rating: (Not rated) (Rate It)


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

corner
© 1996-2008 CommunityHeaven LLC. All rights reserved. Reproduction in whole or in part, in any form or medium without express written permission is prohibited.
Violators of this policy may be subject to legal action. Please read our Terms Of Use and Privacy Statement for more information.
North American business development: Nicolai Wadstrom. Publisher: Lars Hagelin.