Guidance
指路人
g.yi.org
software / rapidq / Examples / Algorithm & Maths / Randomizer.bas

Register 
注册
Search 搜索
首页 
Home Home
Software
Upload

  
'
' Password Generator
' (C) 2003 Martin Wehner
'
' Contact:  mailto:martin.wehner@firemail.de
' Homepage: http://mitglied.lycos.de/maweso/
'
' Compile this source code with the RapidQ Compiler
' (available at http://www.basicguru.com/rapidq).
' For better runtime stability it is highly recommended
' to use the patched Rapid-Q Library Files available at
' http://www.angelfire.com/space/netcensus/ when
' compiling this source.
'
' If you execute the application with a filename as
' parameter then all generated passwords are appended
' to the file specified by the filename.
'
' This source code is distributed under GNU General
' Public License.
'

     $APPTYPE GUI
     $OPTIMIZE ON
     $TYPECHECK ON
     $ESCAPECHARS OFF
     $INCLUDE "RAPIDQ.INC"

     CONST CR = CHR$(13)
     CONST MAX_PATH = 260
     CONST GWL_HWNDPARENT = (-8)
     CONST DIGITS = "0123456789"
     CONST LOWER_CHARACTERS = "abcdefghijklmnopqrstuvwxyz"
     CONST UPPER_CHARACTERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
     CONST SPECIAL_CHARACTERS = "!$%&/()=?*_:;,.-+~><|}{[]#@"

'$DEFINE GERMAN
     $IFDEF GERMAN
      CONST APPNAME = "Passwort Generator"
      CONST VERSION = "1.0"
      CONST LICENSE = "Dieses Programm ist Freeware unter GNU-Lizenz."
      CONST SOURCE = "Den Quelltext finden Sie auf der Homepage des Autors."
      CONST MAIL = "Kontakt: martin.wehner@firemail.de"
      CONST WWW = "Homepage: mitglied.lycos.de/maweso"
      CONST LABEL01 = "Länge des Passworts"
      CONST LABEL02 = "Buchstaben"
      CONST LABEL03 = "Passwort besteht aus"
      CONST LABEL04 = "Ziffern"
      CONST LABEL05 = "Kleinbuchstaben"
      CONST LABEL06 = "Großbuchstaben"
      CONST LABEL07 = "Sonderzeichen:"
      CONST LABEL08 = "Erzeuge Passwörter"
      CONST LABEL09 = "Per Doppelklick kopieren Sie ein Passwort in die Zwischenablage."
      CONST LABEL10 = "Info..."
      CONST LABEL11 = "Beenden"
     $ELSE
      CONST APPNAME = "Password Generator"
      CONST VERSION = "1.0"
      CONST LICENSE = "This program is Freeware under GNU General Public License."
      CONST SOURCE = "The source code is available on the author's homepage."
      CONST MAIL = "Contact: martin.wehner@firemail.de"
      CONST WWW = "Homepage: mitglied.lycos.de/maweso"
      CONST LABEL01 = "Length of Password"
      CONST LABEL02 = "Characters"
      CONST LABEL03 = "Password contains"
      CONST LABEL04 = "Digits"
      CONST LABEL05 = "Lower Characters"
      CONST LABEL06 = "Upper Characters"
      CONST LABEL07 = "Special Characters:"
      CONST LABEL08 = "Generate Passwords"
      CONST LABEL09 = "Double click a line to copy the password to the clipboard."
      CONST LABEL10 = "About..."
      CONST LABEL11 = "Exit"
     $ENDIF

     DECLARE SUB AboutBox
     DECLARE SUB Generate
     DECLARE SUB FormClose
     DECLARE SUB SendToClipboard
     DECLARE SUB ChangeSpecial
     DECLARE SUB ChangeCheck

     Application.Title = APPNAME

     DIM FileName AS STRING
     FileName = ""
     DIM Font AS QFONT
     Font.Name = "Fixedsys"

     DIM MainForm AS QFORM
     WITH MainForm
      .Center
      .CAPTION = APPNAME
      .Height = 300
      .Width = 400
      .DelBorderIcons biMaximize
      .BorderStyle = bsSingle
     END WITH

     DIM GroupLength AS QGROUPBOX
     WITH GroupLength
      .PARENT = MainForm
      .CAPTION = LABEL01
      .Top = 15
      .Left = 15
      .Width = 160
      .Height = 50
     END WITH

     DIM ComboLength AS QCOMBOBOX
     WITH ComboLength
      .PARENT = GroupLength
      .Top = 19
      .Left = 8
      .Width = 45
      .DropDownCount = 13
      .AddItems "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16"
      .ItemIndex = 4
     END WITH

     DIM LabelCharacters AS QLABEL
     WITH LabelCharacters
      .PARENT = GroupLength
      .CAPTION = LABEL02
      .Top = 24
      .Left = 60
     END WITH

     DIM GroupCheck AS QGROUPBOX
     WITH GroupCheck
      .PARENT = MainForm
      .CAPTION = LABEL03
      .Top = 80
      .Left = 15
      .Width = 160
      .Height = 132
     END WITH

     DIM CheckDigit AS QCHECKBOX
     WITH CheckDigit
      .PARENT = GroupCheck
      .CAPTION = LABEL04
      .Top = 19
      .Left = 8
      .Width = 150
      .Checked = True
      .OnClick = ChangeCheck
     END WITH

     DIM CheckLChar AS QCHECKBOX
     WITH CheckLChar
      .PARENT = GroupCheck
      .CAPTION = LABEL05
      .Top = 39
      .Left = 8
      .Width = 150
      .Checked = True
      .OnClick = ChangeCheck
     END WITH

     DIM CheckUChar AS QCHECKBOX
     WITH CheckUChar
      .PARENT = GroupCheck
      .CAPTION = LABEL06
      .Top = 59
      .Left = 8
      .Width = 150
      .Checked = True
      .OnClick = ChangeCheck
     END WITH

     DIM CheckSpecial AS QCHECKBOX
     WITH CheckSpecial
      .PARENT = GroupCheck
      .CAPTION = LABEL07
      .Top = 79
      .Left = 8
      .Width = 150
      .Checked = True
      .OnClick = ChangeCheck
     END WITH

     DIM EditSpecial AS QEDIT
     WITH EditSpecial
      .PARENT = GroupCheck
      .Text = SPECIAL_CHARACTERS
      .Top = 101
      .Left = 8
      .Width = 144
      .OnChange = ChangeSpecial
     END WITH

     DIM ButtonGenerate AS QBUTTON
     WITH ButtonGenerate
      .PARENT = MainForm
      .CAPTION = LABEL08
      .Top = 230
      .Left = 15
      .Width = 160
      .Height = 25
      .OnClick = Generate
     END WITH

     DIM LabelHint AS QLABEL
     WITH LabelHint
      .PARENT = MainForm
      .WordWrap = True
      .Alignment = taCenter
      .CAPTION = LABEL09
      .Top = 15
      .Left = 192
      .Width = 187
      .Height = 30
     END WITH

     DIM ListPassword AS QLISTBOX
     WITH ListPassword
      .PARENT = MainForm
      .Top = 50
      .Left = 192
      .Width = 187
      .Height = 162
      .Font = Font
      .OnDblClick = SendToClipboard
     END WITH

     DIM ButtonAbout AS QBUTTON
     WITH ButtonAbout
      .PARENT = MainForm
      .CAPTION = LABEL10
      .Top = 230
      .Left = 198
      .Width = 80
      .Height = 25
      .OnClick = AboutBox
     END WITH

     DIM ButtonExit AS QBUTTON
     WITH ButtonExit
      .PARENT = MainForm
      .CAPTION = LABEL11
      .Top = 230
      .Left = 299
      .Width = 80
      .Height = 25
      .OnClick = FormClose
     END WITH

     SUB ChangeCheck
      IF LEN(EditSpecial.Text) = 0 AND CheckSpecial.Checked THEN EditSpecial.Text = SPECIAL_CHARACTERS
      ButtonGenerate.Enabled = CheckDigit.Checked OR CheckLChar.Checked OR CheckUChar.Checked OR CheckSpecial.Checked
     END SUB

     SUB ChangeSpecial
      IF LEN(EditSpecial.Text) = 0 THEN CheckSpecial.Checked = False
     END SUB

     SUB Generate
      DIM f AS QFILESTREAM
      DIM m AS STRING, p AS STRING, s AS STRING
      DIM i AS INTEGER, j AS INTEGER, n AS INTEGER

      RANDOMIZE VAL(REVERSE$(STR$(TIMER * 1000.0)))

      WITH ComboLength
       n = LEN(.Text)
       WHILE 0 < n
        n = IIF(INSTR(DIGITS, .Text[n]), n - 1, -1)
       WEND
       IF n < 0 THEN .ItemIndex = 4

       n = VAL(.Text)
       IF n < 4 THEN .ItemIndex = 0
       IF 99 < n THEN .Text = "99"
      END WITH

      ListPassword.Clear
      FOR i = 1 TO 20
       p = ""

       m = IIF(CheckDigit.Checked, "+", "-")
       m = m + IIF(CheckLChar.Checked, "+", "-")
       m = m + IIF(CheckUChar.Checked, "+", "-")
       m = m + IIF(CheckSpecial.Checked, "+", "-")

       n = VAL(ComboLength.Text)
       WHILE 0 < n
        s = IIF(m[1] <> "-", DIGITS, "")
        IF m[2] <> "-" THEN s = s + LOWER_CHARACTERS
        IF m[3] <> "-" THEN s = s + UPPER_CHARACTERS
        IF m[4] <> "-" THEN s = s + EditSpecial.Text

        n = LEN(s)
        j = INT(RND(n))
        IF j < n THEN
         s = s[j + 1]

         IF m[1] <> "-" THEN j = j - LEN(DIGITS)
         IF j < 0 THEN
          m = REPLACE$(m, "*", 1)
         ELSE
          IF m[2] <> "-" THEN j = j - LEN(LOWER_CHARACTERS)
          IF j < 0 THEN
           m = REPLACE$(m, "*", 2)
          ELSE
           IF m[3] <> "-" THEN j = j - LEN(UPPER_CHARACTERS)
           m = REPLACE$(m, "*", IIF(j < 0, 3, 4))
          END IF
         END IF

         n = LEN(p)
         j = INT(RND(n + 1))
         IF j < n THEN
          s = s + RIGHT$(p, n - j)
          IF j = 0 THEN
           p = ""
          ELSE
           p = LEFT$(p, j)
          END IF
         END IF
         p = p + s
        END IF

        n = VAL(ComboLength.Text) - LEN(p)
        IF n <= TALLY(m, "+") THEN m = REPLACESUBSTR$(m, "*", "-")
       WEND

       IF FileName <> "" THEN
        WITH f
         IF FILEEXISTS(FileName) THEN
          IF .OPEN(FileName, fmOpenWrite) THEN
           .Seek(0, soFromEnd)
           .WriteLine(p)
           .CLOSE
          END IF
         ELSEIF .OPEN(FileName, fmCreate) THEN
          .WriteLine(p)
          .CLOSE
         END IF
        END WITH
       END IF

       ListPassword.AddItems(p)
      NEXT
     END SUB

     SUB SendToClipboard
      DIM i AS INTEGER

      i = ListPassword.ItemIndex
      IF 0 <= i THEN
       WITH CLIPBOARD
        .OPEN
        .Text = ListPassword.Item(i)
        .CLOSE
       END WITH
      END IF
     END SUB

     SUB AboutBox
      SHOWMESSAGE(APPNAME + " " + VERSION + CR + "(C) 2003 Martin Wehner" + CR + CR + MAIL + CR + WWW + CR + CR + LICENSE + CR + SOURCE)
     END SUB

     SUB FormClose
      MainForm.CLOSE
     END SUB

     DECLARE FUNCTION GetFullPathNameAPI LIB "kernel32" ALIAS "GetFullPathNameA" (BYVAL lpFileName AS STRING, BYVAL nBufferLength AS LONG, BYVAL lpBuffer AS LONG, BYVAL lpFilePart AS STRING) AS LONG
     IF COMMANDCOUNT = 1 THEN
      DIM n AS INTEGER
      DIM s AS STRING

      s = SPACE$(MAX_PATH)
      n = GetFullPathNameAPI(COMMAND$(1), LEN(s), VARPTR(s), "")
      IF 0 < n THEN FileName = LEFT$(s, n)
     END IF

     DECLARE FUNCTION SetWindowLongAPI LIB "user32" ALIAS "SetWindowLongA" (BYVAL hwnd AS LONG, BYVAL nIndex AS LONG, BYVAL dwNewLong AS LONG) AS LONG
     SetWindowLongAPI(MainForm.Handle, GWL_HWNDPARENT, 0)
     SetWindowLongAPI(Application.Handle, GWL_HWNDPARENT, MainForm.Handle)

     MainForm.SHOWMODAL
掌柜推荐
 
 
 
 
 
 
 
 
 
 
 
 
© Fri 2024-4-19  Guidance Laboratory Inc.
Email:webmaster1g.yi.org Hits:0 Last modified:2009-07-25 17:30:54