Topic: Blockade after login 5 times

[Adesu]

Hi Alls,
I just create a code to blockade a user,if that user login with not same as my name,then user put code until 5 times,the program and I want blockade or Autocad exit,I knew this code should put in acaddoc.lsp or acad2005doc.lsp,but I still got problem how to count user login until 5 times in lisp program,anyone have time to look my code,and I very apreciated for your help,thanks.
Here Lsp file

Code: [Select]

(defun c:lnm (/ ans dcl_id nam)
  (setq dcl_id (load_dialog "Login Name Manager.dcl"))
  (if
    (not (new_dialog "lnm" dcl_id))
    (exit)
    )
  (set_tile "eb" "Abc")
  (mode_tile "eb" 2)
  (action_tile "eb" "(setq nam (get_tile \"eb\"))")                             
  (action_tile "accept" "(done_dialog 1)")
  (action_tile "cancel" "(done_dialog 0)(exit)")
  (setq ans (start_dialog))
  (if
    nam
    (progn
      (if (= nam "")(c:lnm))
      (if
(or (= nam "Adesu")(= nam "adesu"))
(progn
  (alert (strcat "\nYou are right !!!"
"\n"
"\nMy name is "
"\n"
"\n" nam))
  (exit)
  )                            ; progn
)                              ; if
      (if
(or (/= nam "Adesu")(/= nam "adesu"))
(c:lnm)
)                                  ; if
      )                                    ; progn
    (c:lnm)
    )                                      ; if
  (princ)
  )                                     ; defun 
here DCL file

Code: [Select]

// lnm is for Login Name Manager
lnm : dialog {label = "LOGIN NAME MANAGER";
    : column {label = "Enter your name here";
    : edit_box {key = "eb";}}
    ok_cancel;}


[Patrick_35]

Hi

Code: [Select]

(defun c:lnm(/ cnt rep)

  (defun MsgBox (Titre Bouttons Message / Reponse WshShell)
    (setq WshShell (vlax-create-object "WScript.Shell"))
    (setq Reponse  (vlax-invoke WshShell 'Popup Message 7 Titre (itoa Bouttons)))
    (vlax-release-object WshShell)
    Reponse
  )

  (defun InputBox (Titre Message Defaut / *acad* users1 valeur)
    (setq *acad* (vlax-get-acad-object) users1 (getvar "users1"))
    (acad-push-dbmod)
    (vla-eval *acad* (strcat "ThisDrawing.SetVariable \"USERS1\"," "InputBox (\"" Message "\", \"" Titre "\", \"" Defaut "\")"))
    (setq valeur (getvar "users1"))
    (setvar "users1" users1)
    (acad-pop-dbmod)
    valeur
  )

  (setq cnt 0)
  (while (and (< cnt 5) (not (eq rep "Adesu")) (not (eq rep "adesu")))
    (setq rep (inputbox "LOGIN NAME MANAGER" "Enter your name here" "Abc") cnt (1+ cnt))
  )
  (if (and (not (eq rep "Adesu")) (not (eq rep "adesu")))
    (progn
      (msgbox "LOGIN NAME MANAGER" 16 "Incorrect login")
      (vla-quit (vlax-get-acad-object))
    )
    (msgbox "LOGIN NAME MANAGER" 64 "To be continue")
  )
  (princ)
)
@+

[CAB]

Patrick_35
Nice example. I was able to find this
http://tinyurl.com/c6nw2
but was wondering if you had the complete options list for buttons & Icon Types?

The previous two tables do not cover all values for nType. For a complete list,
see the Microsoft Win32 documentation.

[Patrick_35]

Yes, and i find it in the ..... vba help 
You can see all options in http://www.w3schools.com/vbscript/func_msgbox.asp

And I profit it for post two others of the same type 

Code: [Select]

(defun FileBox(/ cdl f)
;OFN_READONLY &H1       1 La case 'Lecture seule' est cochée à la création de la fenêtre.
;OFN_OVERWRITEPROMPT &H2       2 Afficher un message de confirmation d'écrasement de fichier si celui-ci existe déjà.
;OFN_HIDEREADONLY &H4       4 Case à cocher 'Lecture seule' invisible.
;OFN_NOCHANGEDIR &H8       8 Conserve le répertoire d'origine à la fermeture de la fenêtre.
;OFN_SHOWHELP &H10      16 Afficher le bouton 'Aide' dans la boîte de dialogue.
;OFN_NOVALIDATE &H100     256 Ne vérifie pas la validité de la saisie (validité du nom de fichier).
;OFN_ALLOWMULTISELECT &H200     512 Autoriser la sélection multiple de fichiers.
;OFN_EXTENSIONDIFFERENT &H400    1024 Indique que l'utilisateur a choisi une extension différente de celle par défaut.
;OFN_PATHMUSTEXIST &H800    2048 Les chemins et fichiers saisis doivent exister.
;OFN_FILEMUSTEXIST &H1000    4096 Seuls des fichiers existants peuvent être saisis.
;OFN_CREATEPROMPT &H2000    8192 Afficher une fenêtre de confirmation de création de fichier.
;OFN_SHAREAWARE &H4000   16384 Ignorer les erreurs de partage réseau.
;OFN_NOREADONLYRETURN &H8000   32768 Ne sélectionne pas la case à cocher 'Lecture seule'.
;OFN_NOTESTFILECREATE &H10000   65536 Le fichier ne sera pas créé avant la fermeture de la fenêtre.
;OFN_NONETWORKBUTTON &H20000 131072 Cache (désactive) le bouton 'Réseau'.
;OFN_NOLONGNAMES &H40000 262144 Utilise les noms courts de fichier (sans effet dans le cas des fenêtres du type 'Explorer').

;OFN_EXPLORER &H80000 524288 Donne un style 'Explorer' à la boîte de dialogue (par défaut).
; Qui ne fonctionne apparement pas sous XP

;OFN_LONGNAMES &H200000 2097152 Gestion des noms longs pour les boîtes de dialogue n'ayant pas le style 'Explorer'.
;OFN_NODEREFERENCELINKS &H100000 1048576 La boîte de dialogue prendra le nom et le chemin du raccourci sélectionné.

  (setq cdl (vlax-create-object "userAccounts.CommonDialog"))
  (vlax-put-property cdl 'filter (vlax-make-variant "Fichiers dessins (*.dwg)| *.dwg |Fichiers DXF (*.dwf) |Tous les fichiers (*.*)|*.*"))
  (vlax-put-property cdl 'filterindex 1)
  (vlax-put-property cdl 'flags (+ 4 8 512 2048 4096 131072 2097152))
  (vlax-put-property cdl 'initialdir (getvar "dwgprefix"))
  (if (eq (vlax-invoke cdl 'showopen) -1)
    (setq f (vlax-get-property cdl 'filename))
    (setq f nil)
  )
  (vlax-release-object she)
  f
)

Code: [Select]

(defun DirBox(Message Chemin Drapeau / rep sh)
; Valeur du Drapeau
;     0 = Valeur par défaut
;     1 = BIF_RETURNONLYFSDIRS = Seulement les fichiers système
;     2 = BIF_DONTGOBELOWDOMAIN = Interdit d'explorer en dehors du domaine
;     4 = BIF_STATUSTEXT = Inclure un secteur de statut. La fonction de rappel de service peut placer le texte de statut en envoyant des messages à la zone de dialogue. Ce drapeau n'est pas soutenu quand BIF_NEWDIALOGSTYLE est indiqué.
;     8 = BIF_RETURNFSANCESTORS = Seulement les sous Dossiers
;    16 = BIF_EDITBOX = Inclure une commande d'édition dans la zone de dialogue
;    32 = BIF_VALIDATE = Verifie si l'utilisateur dactylographie un nom inadmissible dans la boîte d'édition
;   512 = BIF_NONEWFOLDERBUTTON = Ne pas inclure le bouton Créer un nouveau dossier
;  4096 = BIF_BROWSEFORCOMPUTER = Autorise à parcourir le réseau
;  8192 = BIF_BROWSEFORPRINTER = Seulement le choix d'une imprimante
; 16384 = BIF_BROWSEINCLUDEFILES = Montre tout
; = BIF_BROWSEINCLUDEURLS = Montrer les raccourcis, Les drapeaux BIF_USENEWUI et de BIF_BROWSEINCLUDEFILES doivent également être placés
; = BIF_NEWDIALOGSTYLE = Employer la nouvelle interface utilisateur
; = BIF_NOTRANSLATETARGETS = Quand l'article choisi est un raccourci, renvoyer le PIDL du raccourci lui-même plutôt que sa cible.
; = BIF_SHAREABLE = Peut montrer les ressources en commun sur les systèmes à distance. Le drapeau de BIF_NEWDIALOGSTYLE doit également être placé.
; = BIF_UAHINT = Une fois combiné avec BIF_NEWDIALOGSTYLE, ajoute un conseil d'utilisation à la zone de dialogue au lieu de la boîte d'édition. BIF_EDITBOX dépasse ce drapeau.
; = BIF_USENEWUI = Employer la nouvelle interface utilisateur, y compris une boîte d'édition

  (setq sh (vlax-create-object "Shell.Application"))
  (if (setq rep (vlax-invoke sh 'browseforfolder 0 Message Drapeau Chemin))
    (setq rep (vlax-get-property (vlax-get-property rep 'self) 'path))
    (setq rep nil)
  )
  (vlax-release-object sh)
  rep
)
Sorry for the french help  but for the function filebox, you can read http://vbcity.com/forums/faq.asp?fid=38&cat=Common+Dialog
For the function dirbox http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=375&lngWId=10
And if you want to have fun with certain functions, look at http://msdn.microsoft.com/library/default.asp?url=/library/en-us/shellcc/platform/shell/reference/objects/shell/browseforfolder.asp

@+

[CAB]

Thanks Patrick,
That's very helpful.

[Adesu]

Hi Patrick,
it's cool and nice,many thanks for your sample code.

Hi

Code: [Select]

(defun c:lnm(/ cnt rep)

  (defun MsgBox (Titre Bouttons Message / Reponse WshShell)
    (setq WshShell (vlax-create-object "WScript.Shell"))
    (setq Reponse  (vlax-invoke WshShell 'Popup Message 7 Titre (itoa Bouttons)))
    (vlax-release-object WshShell)
    Reponse
  )

  (defun InputBox (Titre Message Defaut / *acad* users1 valeur)
    (setq *acad* (vlax-get-acad-object) users1 (getvar "users1"))
    (acad-push-dbmod)
    (vla-eval *acad* (strcat "ThisDrawing.SetVariable \"USERS1\"," "InputBox (\"" Message "\", \"" Titre "\", \"" Defaut "\")"))
    (setq valeur (getvar "users1"))
    (setvar "users1" users1)
    (acad-pop-dbmod)
    valeur
  )

  (setq cnt 0)
  (while (and (< cnt 5) (not (eq rep "Adesu")) (not (eq rep "adesu")))
    (setq rep (inputbox "LOGIN NAME MANAGER" "Enter your name here" "Abc") cnt (1+ cnt))
  )
  (if (and (not (eq rep "Adesu")) (not (eq rep "adesu")))
    (progn
      (msgbox "LOGIN NAME MANAGER" 16 "Incorrect login")
      (vla-quit (vlax-get-acad-object))
    )
    (msgbox "LOGIN NAME MANAGER" 64 "To be continue")
  )
  (princ)
)
@+

[Adesu]

Hi Patrick,
Your code is good,but for me,I'm not yet familiar with "WScript.Shell" ,what function that code,would you give info about that,thanks.

Hi

Code: [Select]

(defun c:lnm(/ cnt rep)

  (defun MsgBox (Titre Bouttons Message / Reponse WshShell)
    (setq WshShell (vlax-create-object "WScript.Shell"))
    (setq Reponse  (vlax-invoke WshShell 'Popup Message 7 Titre (itoa Bouttons)))
    (vlax-release-object WshShell)
    Reponse
  )

  (defun InputBox (Titre Message Defaut / *acad* users1 valeur)
    (setq *acad* (vlax-get-acad-object) users1 (getvar "users1"))
    (acad-push-dbmod)
    (vla-eval *acad* (strcat "ThisDrawing.SetVariable \"USERS1\"," "InputBox (\"" Message "\", \"" Titre "\", \"" Defaut "\")"))
    (setq valeur (getvar "users1"))
    (setvar "users1" users1)
    (acad-pop-dbmod)
    valeur
  )

  (setq cnt 0)
  (while (and (< cnt 5) (not (eq rep "Adesu")) (not (eq rep "adesu")))
    (setq rep (inputbox "LOGIN NAME MANAGER" "Enter your name here" "Abc") cnt (1+ cnt))
  )
  (if (and (not (eq rep "Adesu")) (not (eq rep "adesu")))
    (progn
      (msgbox "LOGIN NAME MANAGER" 16 "Incorrect login")
      (vla-quit (vlax-get-acad-object))
    )
    (msgbox "LOGIN NAME MANAGER" 64 "To be continue")
  )
  (princ)
)
@+

[Adesu]

Hi,
I just got it as I want,here that code after I revised

Code: [Select]

(defun c:lnm (/ cnt len lst_str rtn str)
  (setq str (dos_getstring "LOGIN NAME MANAGER" "Enter your name here"))
  (if
    (or (= str "Adesu")(= str "adesu"))
(progn
  (alert (strcat "\nYou are right !!!"
"\n"
"\nMy name is "
"\n"
"\n" str))
  (exit)
  )                               ; progn
)                                 ; if
  (setq cnt 1)
  (setq rtn 10)
  (repeat
    rtn
    (if
      (and (not (eq str "Adesu"))(not (eq str "adesu")))
      (progn
(setq lst_str
       (append lst_str
       (list (dos_getstring "LOGIN NAME MANAGER" "Enter your name here"))))
(setq len (length lst_str))
(if
  (= len 4)
  (command "_quit")
  )                                     ; if
(setq cnt (1+ cnt))
)                                       ; progn
      )                                         ; if
    )                                           ; repeat
  (princ) 
  )                                             ; defun


Hi Alls,
I just create a code to blockade a user,if that user login with not same as my name,then user put code until 5 times,the program and I want blockade or Autocad exit,I knew this code should put in acaddoc.lsp or acad2005doc.lsp,but I still got problem how to count user login until 5 times in lisp program,anyone have time to look my code,and I very apreciated for your help,thanks.
Here Lsp file

Code: [Select]

(defun c:lnm (/ ans dcl_id nam)
  (setq dcl_id (load_dialog "Login Name Manager.dcl"))
  (if
    (not (new_dialog "lnm" dcl_id))
    (exit)
    )
  (set_tile "eb" "Abc")
  (mode_tile "eb" 2)
  (action_tile "eb" "(setq nam (get_tile \"eb\"))")                             
  (action_tile "accept" "(done_dialog 1)")
  (action_tile "cancel" "(done_dialog 0)(exit)")
  (setq ans (start_dialog))
  (if
    nam
    (progn
      (if (= nam "")(c:lnm))
      (if
(or (= nam "Adesu")(= nam "adesu"))
(progn
  (alert (strcat "\nYou are right !!!"
"\n"
"\nMy name is "
"\n"
"\n" nam))
  (exit)
  )                            ; progn
)                              ; if
      (if
(or (/= nam "Adesu")(/= nam "adesu"))
(c:lnm)
)                                  ; if
      )                                    ; progn
    (c:lnm)
    )                                      ; if
  (princ)
  )                                     ; defun 
here DCL file

Code: [Select]

// lnm is for Login Name Manager
lnm : dialog {label = "LOGIN NAME MANAGER";
    : column {label = "Enter your name here";
    : edit_box {key = "eb";}}
    ok_cancel;}


[Patrick_35]

Hi Adesu
With "WScript.Shell", you work with ActiveX and you can't break the dialog
With your method, is you use ctrl+break, you exit lisp

@+

[Adesu]

Oh..I see,many thanks for your input.

Hi Adesu
With "WScript.Shell", you work with ActiveX and you can't break the dialog
With your method, is you use ctrl+break, you exit lisp

@+