;==========================================================================================================================================
; Simple Password Generator.
;
; (c) Detlev Dalitz.20091229.
;------------------------------------------------------------------------------------------------------------------------------------------
; Inspired by
;   Topic:  Random 8 character generator
;   Conf:  WinBatch
;   From:  seckner seckner@gmail.com
;   Date:  Monday, December 28, 2009 04:59 PM
;==========================================================================================================================================

;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfCreatePassword (intLength, strCharSet)
If strCharSet == "" Then Return ""
If intLength < 1 Then Return ""
strPwd = ""
intCharsMax = 0
intSetMax = ItemCount (strCharSet, @TAB)
arrSetRnd = ArrDimension (intSetMax + 1, intLength + 1)
ArrInitialize (arrSetRnd, "?")
For intSet = 1 To intSetMax
   arrSet = ArrayFromStr (ItemExtract (intSet, strCharSet, @TAB))
   intChars = ArrInfo (arrSet, 1)
   If intChars == 0 Then Continue
   intCharsMax = intCharsMax + intChars
   intRndMax = intChars - 1
   intRndOld = -1
   For intPos = 1 To intLength
      intRnd = Random (intRndMax)
      While intRndOld == intRnd
         intRnd = Random (intRndMax)
      EndWhile
      intRndOld = intRnd
      arrSetRnd[intSet, intPos] = arrSet[intRnd]
   Next
Next
If intCharsMax == 0 Then Return ""
Drop (arrSet)
Switch intSetMax
Case 1
   For intPos = 1 To intLength
      strPwd = strPwd : arrSetRnd[1, intPos]
   Next
   Break
Case intSetMax
   intPartRange = Int (LogE (1.0 * intLength / intSetMax))
   intRndMax = intSetMax - 1
   intSetOld = -1
   intPos = 0
   While @TRUE
      intSet = Random (intRndMax)
      While intSetOld == intSet
         intSet = Random (intRndMax)
      EndWhile
      intSetOld = intSet
      intPartMax = Random (intPartRange)
      intPart = 0
      While @TRUE
         If intPart > intPartMax Then Break
         intPos = intPos + 1
         If intPos > intLength Then Break
         strPwd = strPwd : arrSetRnd[intSet + 1, intPos]
         intPart = intPart + 1
      EndWhile
      If intPos > intLength Then Break
   EndWhile
EndSwitch
Drop (arrSetRnd)
Return strPwd
;..........................................................................................................................................
; This UDF "udfCreatePassword" creates a password string, which is randomly assembled from a given list of distinct character sets.
;
; Parameter "intLength" is an integer value which determines the length of the password string.
; Parameter "strCharSet" determines the set of characters which can be used for assembling the password string.
;
; For creation of a low strength password the parameter "strCharSet" can consist of one string of characters,
; for example: "abcdef1234".
;
; For creation of a strong password the parameter "strCharSet" should consist of a @TAB separated list of string items of different data types,
; for example: strCharSet = "abcdef" : @TAB : "12345" : @TAB : "()=!"  (lower chars, numbers, special chars).
;
; Dis-/Advantages of this algorithm:
; Password characters are chosen randomly from predefined types of character sets.
; No two same characters side by side (only if character set contains unique chars, otherwise doubled characters are possible).
; No two same types of character sets side by side.
;
; (c) Detlev Dalitz.20091229.
;..........................................................................................................................................
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------


; Main.

IntControl (49, 1, 0, 0, 0) ; Add system menu to dialog window.

strSetLower = "abcdefghijklmnopqrstuvwxyz" ; Minimal two letters.
strSetUpper = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" ; Minimal two letters.
strSetNumbers = "0123456789"               ; Minimal two numbers.
strSetSpecials = "!@#$^&*()?"              ; Minimal two special characters.

strSetLower = "winbatch"
strSetUpper = "SEATTLE"
strSetNumbers = GetTickCount ()
strSetSpecials = "#$_!"

strListType = "Letters" : @TAB : "Numbers" : @TAB : "Specials" : @TAB : "Letters and Numbers" : @TAB : "Letters and Specials" : @TAB : "Letters, Numbers and Specials"
strListCase = "Lower" : @TAB : "Upper" : @TAB : "Lower and Upper"

strTypeDefault = "Letters and Numbers"
strCaseDefault = "Lower"
strPwdDefault = ""
intLengthDefault = 8
intTimesDefault = 1

strType = strListType
strCase = strListCase

strPwd = ""

While @TRUE
   intLength = intLengthDefault
   intTimes = intTimesDefault

   MyDialogFormat = `WWWDLGED,6.2`

   MyDialogCaption = `DD's Password Generator`
   MyDialogX = 2001
   MyDialogY = 2001
   MyDialogWidth = 170
   MyDialogHeight = 174
   MyDialogNumControls = 014
   MyDialogProcedure = `DEFAULT`
   MyDialogFont = `Microsoft Sans Serif|6656|40|34`
   MyDialogTextColor = `0|0|0`
   MyDialogBackground = `DEFAULT,DEFAULT`
   MyDialogConfig = 0

   MyDialog001 = `005,003,154,012,STATICTEXT  ,StaticText_5     ,DEFAULT    ,"DD's Password Generator",DEFAULT,1,512    ,"Microsoft Sans Serif|9728|40|34","0|0|128",DEFAULT`
   MyDialog002 = `005,021,156,074,GROUPBOX    ,GroupBox_1       ,DEFAULT    ,"Options"                ,DEFAULT,3,DEFAULT,"Microsoft Sans Serif|6656|40|34",DEFAULT  ,DEFAULT`
   MyDialog003 = `035,035,120,046,DROPLISTBOX ,DropListBox_1    ,"strType"  ,"%strTypeDefault%"       ,DEFAULT,1,4      ,"Microsoft Sans Serif|6656|40|34",DEFAULT  ,DEFAULT`
   MyDialog004 = `011,037,018,008,STATICTEXT  ,StaticText_Type: ,DEFAULT    ,"Type:"                  ,DEFAULT,5,DEFAULT,"Microsoft Sans Serif|6656|40|34",DEFAULT  ,DEFAULT`
   MyDialog005 = `035,055,120,054,DROPLISTBOX ,DropListBox_2    ,"strCase"  ,"%strCaseDefault%"       ,DEFAULT,2,4      ,"Microsoft Sans Serif|6656|40|34",DEFAULT  ,DEFAULT`
   MyDialog006 = `011,057,018,008,STATICTEXT  ,StaticText_Case: ,DEFAULT    ,"Case:"                  ,DEFAULT,7,DEFAULT,"Microsoft Sans Serif|6656|40|34",DEFAULT  ,DEFAULT`
   MyDialog007 = `061,075,030,012,SPINNER     ,Spinner_2        ,"intLength",DEFAULT                  ,DEFAULT,3,DEFAULT,"Microsoft Sans Serif|6656|40|34",DEFAULT  ,DEFAULT`
   MyDialog008 = `125,075,030,012,SPINNER     ,Spinner_1        ,"intTimes" ,DEFAULT                  ,DEFAULT,4,DEFAULT,"Microsoft Sans Serif|6656|40|34",DEFAULT  ,DEFAULT`
   MyDialog009 = `037,077,022,008,STATICTEXT  ,StaticText_Length,DEFAULT    ,"Length:"                ,DEFAULT,7,DEFAULT,"Microsoft Sans Serif|6656|40|34",DEFAULT  ,DEFAULT`
   MyDialog010 = `101,077,020,008,STATICTEXT  ,StaticText_Times ,DEFAULT    ,"Times:"                 ,DEFAULT,7,DEFAULT,"Microsoft Sans Serif|6656|40|34",DEFAULT  ,DEFAULT`
   MyDialog011 = `007,097,020,008,STATICTEXT  ,StaticText_1     ,DEFAULT    ,"Result:"                ,DEFAULT,1,DEFAULT,"Microsoft Sans Serif|6656|40|34",DEFAULT  ,DEFAULT`
   MyDialog012 = `005,107,156,038,MULTILINEBOX,MultiLineBox_1   ,"strPwd"   ,DEFAULT                  ,DEFAULT,5,2056   ,"Courier New|7680|40|49"         ,DEFAULT  ,DEFAULT`
   MyDialog013 = `005,151,108,016,PUSHBUTTON  ,PushButton_2     ,DEFAULT    ,"Generate && ClipPut"    ,1      ,6,32     ,"Microsoft Sans Serif|6656|40|34",DEFAULT  ,DEFAULT`
   MyDialog014 = `121,151,040,016,PUSHBUTTON  ,PushButton_Exit  ,DEFAULT    ,"Exit"                   ,0      ,7,DEFAULT,"Microsoft Sans Serif|6656|40|34",DEFAULT  ,DEFAULT`

   ButtonPushed = Dialog ("MyDialog")

   If ButtonPushed == 0 Then Break

   strCharSet = ""
   Switch @TRUE
   Case strType == "Letters"
      Switch @TRUE
      Case strCase == "Lower"
         strCharSet = strSetLower
         Break
      Case strCase == "Upper"
         strCharSet = strSetUpper
         Break
      Case strCase == "Lower and Upper"
         strCharSet = strSetLower : @TAB : strSetUpper
      EndSwitch
      Break
   Case strType == "Letters and Numbers"
      Switch @TRUE
      Case strCase == "Lower"
         strCharSet = strSetLower : @TAB : strSetNumbers
         Break
      Case strCase == "Upper"
         strCharSet = strSetUpper : @TAB : strSetNumbers
         Break
      Case strCase == "Lower and Upper"
         strCharSet = strSetLower : @TAB : strSetUpper : @TAB : strSetNumbers
      EndSwitch
      Break
   Case strType == "Letters and Specials"
      Switch @TRUE
      Case strCase == "Lower"
         strCharSet = strSetLower : @TAB : strSetSpecials
         Break
      Case strCase == "Upper"
         strCharSet = strSetUpper : @TAB : strSetSpecials
         Break
      Case strCase == "Lower and Upper"
         strCharSet = strSetLower : @TAB : strSetUpper : @TAB : strSetSpecials
      EndSwitch
      Break
   Case strType == "Letters, Numbers and Specials"
      Switch @TRUE
      Case strCase == "Lower"
         strCharSet = strSetLower : @TAB : strSetNumbers : @TAB : strSetSpecials
         Break
      Case strCase == "Upper"
         strCharSet = strSetUpper : @TAB : strSetNumbers : @TAB : strSetSpecials
         Break
      Case strCase == "Lower and Upper"
         strCharSet = strSetLower : @TAB : strSetUpper : @TAB : strSetNumbers : @TAB : strSetSpecials
      EndSwitch
      Break
   Case strType == "Numbers"
      strCharSet = strSetNumbers
      Break
   Case strType == "Specials"
      strCharSet = strSetSpecials
   EndSwitch

   intTrials = 0
   strPwd = ""
   Switch intTimes
   Case 1
      strPwd = udfCreatePassword (intLength, strCharSet)
      Break
   Case intTimes
      arrPwd = ArrDimension (intTimes + 1)
      intPos = 1
      While @TRUE ; Avoid duplicates.
         intTrials = intTrials + 1
         arrPwd[0] = udfCreatePassword (intLength, strCharSet)
         arrResult = ArrayLocate (arrPwd, arrPwd[0], 1)
         If arrResult[0] == -1
            arrPwd[intPos] = arrPwd[0]
            strPwd = strPwd : @CRLF : arrPwd[0]
            intPos = intPos + 1
         EndIf
         If intPos > intTimes Then Break
         If intTrials >= intTimes * 5 Then Break
      EndWhile
      strPwd = StrSub (strPwd, 3, -1)
   EndSwitch

   intTimes = StrLen (strPwd) - StrLen (StrReplace (strPwd, @CR, "")) + 1 ; Actual items created.

   strTypeDefault = strType
   strCaseDefault = strCase

   strType = strListType
   strCase = strListCase

   ClipPut (strPwd)

   Switch intTimes
   Case 1
      strPwd = "1 password created" : @CRLF : '"' : ItemExtract (1, strPwd, @CR) : '"' : @CRLF : "and put on the clipboard."
      Break
   Case intTimes
      If intTimes > 1 Then strPwd = intTimes : " passwords created like" : @CRLF : '"' : ItemExtract (1, strPwd, @CR) : '"' : @CRLF : "and put on the clipboard." : @CRLF : "Trials: " : intTrials
   EndSwitch

EndWhile

:CANCEL
Exit

;------------------------------------------------------------------------------------------------------------------------------------------
; Examples:
;
; 8 lower letters and numbers:
;   95bq21e9
;   3sk1b31k
;   ch31vy71
;
; 20 lower and upper letters and numbers:
;   2nGKAbuTC471Quon301W
;   KBO982eu175KE131XFfC
;   WQu5olyF983pmx67OKVi
;
; 100 lower letters and numbers:
;   fngua56934abfy3vao096dfdyk1410eycg26wcs10wt4587cql37zcdjc9021dwah63738h098y07uy4lwpj1qsmb3869dstnu83
;   ir859down5906q24251vbzki30zg64015h9gpf21yj9ga51491vmoe6212qfoq3284hfs732m4pqez9gs6106rleq52t2veuaw95
;   6jwt10gzjpg10oz74dvy68405u769twjh86fit3049edsc91549y26948ton37kuiuy21290kh4pzb2cgt41u2623engox18797p
;
; 100 lower and upper letters and numbers and special characters:
;   @?@#Q3uo265f3730?^478ajzu874FPRWrBYD342#)@?3@!dwz84cyqVG*!)(XAUS(0459sjnrTUG8#)6P!*&ed?HWJDy748)?)#9
;   ate105xu734MI($@$bpvwBSUR^cltQyrx?!9626p($(8714?*)$Rzbh#547vp25*?@JojpdVPYKcso$&kxnN*$#!oplJRTK&5RU6
;   6268?)4pncDvmer!?#2429)^!$6175?#ypkJOQl73FEO$)nubg)4089dhbpDsc3H04&9037^)@fk@()^LUL2647cs?WBG4tue4*)
;------------------------------------------------------------------------------------------------------------------------------------------