Вы не вошли. Пожалуйста, войдите или зарегистрируйтесь.
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
I transplanted this plug-in into Visual Lisp,so now I can use DynamicWrapperX in AutoCAD.
At the same time I wish get some help from you if I need.
now it's the link:
http://www.theswamp.org/index.php?topic=37453.0
It seems guests are not allowed to read the topic? As for help, surely, you are welcome. Ask questions if you have any.
Thanks.
Yes,guest are not allowed.
Here is a chinese link:
http://bbs.mjtd.com/thread-85724-1-1.html
I have introduced this plugin to some famous websites.
Thanks to Yuri Popov,thanks to you.
Here is My demo. If you have a AutoCAD,you can run it in it.
(vl-load-com)
(defun c:tt (/ *APP *DOC HWND LIB PATH RET WRAP)
;;add some global variable
(setq *APP (vlax-get-acad-object)) ;CAD application
(setq *DOC (vla-get-ActiveDocument *APP)) ;the current document
(setq path (vla-get-path *DOC)) ;the working path
(setq hwnd (vla-get-hwnd *APP)) ;the handle of application
(setq wrap (vlax-create-object "DynamicWrapperX")) ;Create a DynamicWrapperX object instance
;;Register API functions
(vlax-invoke wrap 'Register "KERNEL32" "LoadLibrary" "i=s" "r=l")
(vlax-invoke wrap 'Register "KERNEL32" "FreeLibrary" "i=l" "r=l")
(vlax-invoke wrap 'Register "KERNEL32" "GetProcAddress" "i=ls" "r=l")
;;Window
(vlax-invoke wrap 'Register "USER32" "CreateWindowEx" "i=lsslllllllll" "r=l")
(vlax-invoke wrap 'Register "USER32" "EnableWindow" "i=ll" "r=l")
(vlax-invoke wrap 'Register "USER32" "FindWindow" "i=ls" "r=l")
(vlax-invoke wrap 'Register "USER32" "FindWindowW" "i=lw" "r=l")
(vlax-invoke wrap 'Register "USER32" "IsWindow" "i=l" "r=l")
(vlax-invoke wrap 'Register "USER32" "GetWindow" "i=ll" "r=l")
(vlax-invoke wrap 'Register "USER32" "GetParent" "i=l" "r=l")
(vlax-invoke wrap 'Register "USER32" "GetWindowLong" "i=ll" "r=l")
(vlax-invoke wrap 'Register "USER32" "GetWindowText" "i=lpl" "r=l")
(vlax-invoke wrap 'Register "USER32" "GetWindowTextW" "i=lpl" "r=l")
(vlax-invoke wrap 'Register "USER32" "SetLayeredWindowAttributes" "i=llbl" "r=l")
(vlax-invoke wrap 'Register "USER32" "SetWindowLong" "i=lll" "r=l")
(vlax-invoke wrap 'Register "USER32" "SetWindowText" "i=ls" "r=l")
(vlax-invoke wrap 'Register "USER32" "ShowWindow" "i=ll" "r=l")
(vlax-invoke wrap 'Register "USER32" "GetWindowRect" "i=lp" "r=l")
(vlax-invoke wrap 'Register "COMCTL32" "InitCommonControls" "r=l")
;;Menu
(vlax-invoke wrap 'Register "USER32" "AppendMenu" "i=llls" "r=l")
(vlax-invoke wrap 'Register "USER32" "CreateMenu" "r=l")
(vlax-invoke wrap 'Register "USER32" "CreatePopupMenu" "r=l")
(vlax-invoke wrap 'Register "USER32" "GetSystemMenu" "i=ll" "r=l")
(vlax-invoke wrap 'Register "USER32" "InsertMenu" "i=lllls" "r=l")
(vlax-invoke wrap 'Register "USER32" "ModifyMenu" "i=lllls" "r=l")
(vlax-invoke wrap 'Register "USER32" "SetMenu" "i=ll" "r=l")
;;Message
(vlax-invoke wrap 'Register "USER32" "GetMessage" "i=plll" "r=l")
(vlax-invoke wrap 'Register "USER32" "TranslateMessage" "i=l" "r=l")
(vlax-invoke wrap 'Register "USER32" "DispatchMessage" "i=l" "r=l")
(vlax-invoke wrap 'Register "USER32" "SendMessage" "i=llll" "r=l")
(vlax-invoke wrap 'Register "USER32" "PostMessage" "i=llll" "r=l")
;;Other
(vlax-invoke wrap 'Register "USER32" "GetClassName" "i=lpl" "r=l")
(vlax-invoke wrap 'Register "USER32" "GetDC" "i=l" "r=l")
(vlax-invoke wrap 'Register "USER32" "ReleaseDC" "i=ll" "r=l")
(vlax-invoke wrap 'Register "USER32" "GetClientRect" "i=lp" "r=l")
(vlax-invoke wrap 'Register "USER32" "FillRect" "i=lll" "r=l")
(vlax-invoke wrap 'Register "GDI32" "CreateSolidBrush" "i=l" "r=l")
(vlax-invoke wrap 'Register "GDI32" "DeleteObject" "i=l" "r=l")
;;Load the DCL
(setq LIB (vlax-invoke wrap 'LoadLibrary "USER32.DLL"))
(setq INS (vlax-invoke wrap 'GetProcAddress LIB "SetLayeredWindowAttributes"))
(vl-catch-all-apply 'DCL_Load)
(vlax-invoke wrap 'FreeLibrary LIB)
(vlax-release-object wrap)
(princ)
)
;;;Main procedure
(defun DCL_Load (/ dcl_id Dialog_Return key keys Dcl_File ALLWNDS DCLHWND
DCLWNDS MENU0 MENU1 MENU2 MENU3 NEWSTYL OLDSTYL SYSMENU)
(setq dcl_id (load_dialog (setq Dcl_File (Write_Dcl)))) ;Load dialogue
(vl-file-delete Dcl_File) ;then delete the temporary .dcl
(setq Dialog_Return 2)
(while (> Dialog_Return 1) ;if it is not ended
(new_dialog "DCL" dcl_id) ;then create a new dialogue by DCL_ID
;;Get the handle and change its styles
(setq DCLHwnd (vlax-invoke wrap 'FindWindow 0 "APIDCL")) ;the handle of dialogue
(setq DCLWnds (AllWindows DCLHwnd wrap)) ;the handles of child windows of DCL
(setq OldStyl (vlax-invoke wrap 'GetWindowLong DCLHwnd -16)) ;Window Styles
(setq NewStyl (+ oldStyl 131072 65536 262144 33554432)) ;WS_MAXIMIZEBOX|WS_MINIMIZEBOX|WS_THICKFRAME|WS_CLIPCHILDREN
(vlax-invoke wrap 'SetWindowLong DCLHwnd -16 NewStyl) ;change the old Window Styles to new styles
(setq oldStyl (vlax-invoke wrap 'GetWindowLong DCLHwnd -20)) ;the old Extended Window Styles
(vlax-invoke wrap 'SetWindowLong DCLHwnd -20 256) ;new Extended Window Styles
;(vlax-invoke wrap 'SetWindowLong DCLHwnd -20 (+ 256 524288)) ;add this line in windows 7 or vista
(vlax-invoke wrap 'SetWindowText DCLHwnd "API in DCL")
;;Create Menus
(setq menu0 (vlax-invoke wrap 'CreateMenu)) ;the main menu
(setq menu1 (vlax-invoke wrap 'CreatePopupMenu)) ;popup menu 1
(setq menu2 (vlax-invoke wrap 'CreatePopupMenu)) ;popup menu 2
(setq menu3 (vlax-invoke wrap 'CreatePopupMenu)) ;popup menu 3
(setq sysmenu (vlax-invoke wrap 'GetSystemMenu DCLHwnd 0)) ;system menu
;;Add some items in main menu
(vlax-invoke wrap 'InsertMenu menu0 0 2048 0 "") ;separator
(vlax-invoke wrap 'InsertMenu menu0 1 1024 1 "&File")
(vlax-invoke wrap 'InsertMenu menu0 2 1024 2 "&Edit")
(vlax-invoke wrap 'InsertMenu menu0 3 1024 3 "&View")
(vlax-invoke wrap 'InsertMenu menu0 4 1024 4 "&Help")
;;Add some items in popup menu 1
(vlax-invoke wrap 'ModifyMenu menu0 1 16 menu1 "&File")
(vlax-invoke wrap 'InsertMenu menu1 1 1024 1001 "&Open")
(vlax-invoke wrap 'InsertMenu menu1 2 1024 1002 "&Save")
(vlax-invoke wrap 'InsertMenu menu1 3 1024 1003 "&Print")
(vlax-invoke wrap 'InsertMenu menu1 4 1024 1004 "&Exit")
;;Add some items in popup menu 2
(vlax-invoke wrap 'ModifyMenu menu0 2 16 menu2 "&Edit")
(vlax-invoke wrap 'InsertMenu menu2 1 1024 2001 "&Add a line")
(vlax-invoke wrap 'InsertMenu menu2 2 1024 2002 "&Erase a object")
(vlax-invoke wrap 'InsertMenu menu2 3 1024 2003 "&Select objects")
;;Add some items in popup menu 3
(vlax-invoke wrap 'ModifyMenu menu0 3 16 menu3 "&View")
(vlax-invoke wrap 'InsertMenu menu3 1 1024 3001 "Zoom &In")
(vlax-invoke wrap 'InsertMenu menu3 2 1024 3002 "Zoom &Out")
(vlax-invoke wrap 'InsertMenu menu3 3 1024 3003 "Zoom &Extend")
;;Add an item in system menu
(vlax-invoke wrap 'AppendMenu sysmenu 1024 4001 "&About")
;;Add these menu into DCL
(vlax-invoke wrap 'SetMenu DCLHwnd menu0)
;;Change the transparent of DCL(in windows 7 or vista)
(vlax-invoke wrap 'SetLayeredWindowAttributes DCLHwnd 0 192 2)
;;Change the background to gradient
(Gradient)
;;-->-->-Initialize dialogue->-->--
(setq keys '("H" "W" "R" "accept" "cancel")) ;the names of all the controls
(foreach key keys
(if (eval (read (strcat key "_bak"))) ;Initialize all controls
(set_tile key (eval (read (strcat key "_bak")))) ;the value of all controls
)
(action_tile key "(Action_DCL_Keys $key $value)") ;action of controls
)
(action_tile "B" "(ssget))") ;action of "select object" button
(vl-catch-all-apply 'MsgProc (list DCLHwnd wrap))
;;--<--<-Start dialogue-<--<--
(setq Dialog_Return (start_dialog)) ;show dialog
(princ)
)
(unload_dialog dcl_id) ;unload dialog
(princ "\nSee you!")
(princ) ;silent quit
)
;;;Deal with all the message from DCL
(defun MsgProc (DCLHwnd wrap / str ptr whwd pMsg aMsg bMsg ret)
(setq str (vlax-invoke wrap 'space 28)) ;the size of MSG is 28
(setq ptr (vlax-invoke wrap 'strptr str)) ;MSG pointer
(while (and
(/= (setq Ret (vlax-invoke wrap 'GetMessage ptr 0 0 0)) 0) ;recieve all the message
(/= (vlax-invoke wrap 'IsWindow DCLHwnd) 0) ;if not quit
)
(setq whwd (vlax-invoke wrap 'numget ptr 0)) ;the owner window of MSG
(setq pMsg (vlax-invoke wrap 'numget ptr 4)) ;parameter of MSG
(setq aMsg (vlax-invoke wrap 'numget ptr 8)) ;addition parameter of MSG
(setq bMsg (vlax-invoke wrap 'numget ptr 12)) ;addition parameter of MSG
(vlax-invoke wrap 'TranslateMessage ptr) ;Translate Message
(vlax-invoke wrap 'DispatchMessage ptr) ;Dispatch Message
(WndProc whwd pMsg aMsg bMsg) ;How to deal with MSG
)
)
;;;Window process
(defun WndProc (whwd pMsg aMsg bMsg)
(cond
( (= whwd DCLHWnd)
(cond
( (and (= pMsg 161) (= aMsg 20)) ;Quit
(princ "\nQuit!")
(DONE_DIALOG 0)
)
( (= pMsg 273) ;Select the menu
(MenuSelect aMsg path DCLHwnd *APP)
)
( (= pMsg 274) ;Select the system menu
(SysMenuSelect aMsg path DCLHwnd *APP)
)
( (and (= pMsg 15)) ;Redraw window
(Gradient)
)
( (and (= pMsg 161) (= aMsg 2)) ;Move window
(Gradient)
)
( (and (= pMsg 161) (<= aMsg 17) (>= aMsg 9)) ;Change the size of window
(Gradient)
)
;;(t (vlax-invoke wrap 'DefWindowProc whwd pMsg aMsg bMsg))
)
)
( (and (= pMsg 514) (= (vlax-invoke wrap 'GetParent whwd) DCLHWnd)) ;Press the button
(buttonAction whwd DCLWnds)
)
( t
;;(vlax-invoke wrap 'ShowWindow DCLHwnd 8)
;;(setq isDCL nil)
)
)
)
;;;infomation of a window
(defun GetWndInfo (pHwnd wrap / string strptr ret name LenName ClsName hInst)
(setq string (vlax-invoke wrap 'space 256))
(setq strPtr (vlax-invoke wrap 'strPtr string "s"))
(setq ret (vlax-invoke wrap 'GetWindowTextW pHwnd strPtr 256))
(setq Name (vlax-invoke wrap 'StrGet strPtr "w"))
(setq LenName (vlax-invoke wrap 'GetClassName pHwnd strPtr 256))
(setq clsName (vlax-invoke wrap 'strget strPtr "s"))
(setq hInst (vlax-invoke wrap 'GetWindowLong pHwnd -6))
(list pHwnd Name ClsName hInst)
)
;;;Get infomation of a window and its child windows
(defun AllWindows (pHwnd wrap / lst ChildWnd info)
(setq lst nil)
(setq lst (cons (getWndInfo pHwnd wrap) lst))
(setq ChildWnd (vlax-invoke wrap 'GetWindow pHwnd 5))
(while (/= ChildWnd 0)
(setq info (getWndInfo ChildWnd Wrap))
(setq lst (cons info lst))
(SETQ childWnd (vlax-invoke wrap 'GetWindow ChildWnd 2))
)
(reverse lst)
)
;;;Get the handles of a window and its child windows
(defun GetAllWnds (pHwnd wrap / lst ChildWnd info)
(setq lst nil)
(setq lst (cons phwnd lst))
(setq ChildWnd (vlax-invoke wrap 'GetWindow pHwnd 5))
(while (/= ChildWnd 0)
(setq lst (append (GetAllWnds ChildWnd wrap) lst))
(SETQ childWnd (vlax-invoke wrap 'GetWindow ChildWnd 2))
)
(reverse lst)
)
;;;Select system menu
(defun SysMenuSelect (aMsg path DCLHwnd *APP)
(cond
( (= aMsg 61440)
(princ "SIZE")
)
( (= aMsg 61440)
(princ "MOVE")
)
( (= aMsg 61728)
(princ "RESTORE")
)
( (= aMsg 61472)
(princ "MIN")
)
( (= aMsg 61488)
(princ "MAX")
)
( (= aMsg 61536)
(princ "CLOSE")
(DONE_DIALOG 0)
)
( (= aMsg 4001)
(alert "You Clicked \"About\".")
)
)
)
;;;Select menu
(defun MenuSelect (aMsg path hwnd *APP / filename ent)
(cond
( (= aMsg 1001)
(if (setq filename (getfiled "Select a Lisp File" path "lsp" 8))
(vlax-invoke wrap 'SetWindowText hwnd filename)
)
)
( (= aMsg 1002)
(princ "\nYou select \"Save\"!")
)
( (= aMsg 1003)
(princ "\nYou select \"Print\"!")
)
( (= aMsg 1004)
(Alert "\nAre you sure to quit?!")
(princ "\nProgram has exit,See you later...\n")
(DONE_DIALOG 0)
)
( (= aMsg 2001)
(entmakex '((0 . "LINE") (10 0 0)(11 1 1)))
)
( (= aMsg 2002)
(EnableCAD T)
(if (setq ent (entsel))
(vla-erase (vlax-ename->vla-object (car ent)))
(princ "\nNo selection!")
)
(EnableCAD nil)
)
( (= aMsg 2003)
(EnableCAD T)
(ssget)
(EnableCAD nil)
)
( (= aMsg 3001)
(vla-ZoomScaled *APP 0.5 acZoomScaledRelative)
)
( (= aMsg 3002)
(vla-ZoomScaled *APP 2.0 acZoomScaledRelative)
)
( (= aMsg 3003)
(vla-ZoomExtents *APP)
)
( (= aMsg 4)
(alert "This is a help.")
)
( (= aMsg 4001)
(alert "Made by DynamicWrapper")
)
)
)
;;;actions of buttons
(defun ButtonAction (whwd lst)
(cond
( (= whwd (car (nth 7 lst)))
(EnableCAD T)
(ssget)
(EnableCAD nil)
)
( (= whwd (car (nth 8 lst)))
(princ "You Pressed \"Accept\"!")
(DONE_DIALOG 1)
)
( (= whwd (car (nth 9 lst)))
(princ "You Pressed \"Cancel\"!")
(DONE_DIALOG 0)
)
( (= whwd (car (nth 10 lst)))
(alert "This is a help.")
)
)
)
;;;Enable CAD command
(defun EnableCAD (flag / hwnd)
(setq hwnd (vla-get-hwnd *APP))
(if flag
(vlax-invoke wrap 'EnableWindow hwnd 1)
(vlax-invoke wrap 'EnableWindow hwnd 0)
)
)
;;;Action of DCL keys
(defun Action_DCL_Keys (key value)
(print (list key value))
(print "*-------*") ;test code,delete later.
(cond
( (= key "accept") ;"accept" button
(Get_DCL_Data)
(done_dialog 1) ;done dialog,and transfer Dialog_Return as 1
)
( (= key "cancel") ;"cancel" button
(done_dialog 0) ;done dialog,and transfer Dialog_Return as 1
)
)
(princ)
)
;;;save the data of DCL
(defun Get_DCL_Data (/ key)
(foreach key keys
(set (read (strcat key "_bak")) (get_tile key)) ;assign every control a value for the next initiation
)
)
;;;make a .DCL file,and get its name
(defun Write_Dcl (/ Dcl_File file str)
(setq Dcl_File (vl-filename-mktemp nil nil ".Dcl"))
(setq file (open Dcl_File "W"))
(foreach str '("/*this copy from nonsmall: Visual DCL*/"
"DCL:dialog"
"{"
" label = \"APIDCL\";"
" :edit_box"
" {"
" key = \"H\" ;"
" label = \"Text 1:\" ;"
" }"
" :edit_box"
" {"
" key = \"W\" ;"
" label = \"Text 2:\" ;"
" }"
" :edit_box"
" {"
" key = \"R\" ;"
" label = \"Text 3:\" ;"
" }"
" :button"
" {"
" key = \"B\" ;"
" label = \"Select Objects\" ;"
" }"
"width = 30;"
"height = 15;"
"ok_cancel_help;"
"spacer_1;"
"}"
)
(write-line str file)
)
(close file)
Dcl_File
)
;;;Convert RGB to numbers
(defun RGB (R G B)
(+ (lsh B 16) (lsh G 8) R)
)
;;;Gradient background
(defun Gradient(/ BOTTOM COLOR HBRUSH HDC LEFT NSIZE PTRREC RETREC RETVAL RIGHT STRREC TOP)
(setq HDC (vlax-invoke wrap 'GetDC DCLHwnd))
(setq strRec (vlax-invoke wrap 'space 16))
(setq ptrRec (vlax-invoke wrap 'strPtr strRec))
(setq retRec (vlax-invoke wrap 'GetClientRect DCLHwnd ptrRec))
(setq left (vlax-invoke wrap 'NumGet ptrRec))
(setq top (vlax-invoke wrap 'NumGet PtrRec 4))
(setq Right (vlax-invoke wrap 'NumGet PtrRec 8))
(setq bottom (vlax-invoke wrap 'NumGet PtrRec 12))
(setq nSize (1+ (/ (- bottom top) 64)))
(setq color 255)
(vlax-invoke wrap 'NumPut nSize PtrRec 12)
(repeat 64
(setq hBrush (vlax-invoke wrap 'CreateSolidBrush (RGB 0 (- 255 color) color)))
(setq retval (vlax-invoke wrap 'FillRect HDC ptrRec hBrush))
(vlax-invoke wrap 'DeleteObject hBrush)
(setq color (- color 4))
(and (< color 0) (setq color 0))
(setq bottom (vlax-invoke wrap 'NumGet PtrRec 12))
(vlax-invoke wrap 'NumPut bottom PtrRec 4)
(vlax-invoke wrap 'NumPut (+ bottom nSize) PtrRec 12)
)
(vlax-invoke wrap 'ReleaseDC DCLHwnd HDC)
)
If you have a AutoCAD,you can run it in it.
I personally don't have it, and I'm afraid Visual Lisp is not so well known in this forum. But thanks for the code anyway, maybe someone will find it useful.
Thanks to Yuri Popov,thanks to you.
Both go to me as I'm Yuri Popov actually. 
Thanks for your kind words and for your effort to make Dynwrapx more popular.
But I must warn you about a possible pitfall in using Dynwrapx on systems with East-Asian ANSI and OEM codepages. Dynwrapx assumes that an ANSI/OEM character is always one byte. AFAIK, that's not true for East-Asian encodings, they are multibyte. Because of this, strings may be truncated when converted between ANSI/OEM and Unicode. So, it's safer to use the Unicode versions of API functions and to avoid using the StrPtr method with an "s" or "z" parameter.
Thanks your advice!
I found a new appliaction in AutoCAD. That is : I can call C functions in vlisp. I couldn't image that before this. It's really amazing.
for example:
(setq wrap (vlax-create-object "DynamicWrapperX"))
;;;random number
(vlax-invoke wrap 'Register "MSVCR70" "srand" "i=l")
(vlax-invoke wrap 'Register "MSVCR70" "time" "i=l" "r=l")
(vlax-invoke wrap 'Register "MSVCR70" "rand" "r=l")
(vlax-invoke wrap 'Register "MSVCR70" "clock" "r=l")
(vlax-invoke wrap 'srand (vlax-invoke wrap 'time 0)) ;seed
(setq t1 (vlax-invoke wrap 'clock))
(setq i 0)
(repeat 100000
;(princ (strcat "\nRandom number " (itoa i) " is:"))
(vlax-invoke wrap 'rand)
(setq i (1+ i))
)
(setq t2 (vlax-invoke wrap 'clock))
(princ "\nIt takes : ")
(princ (/ (- t2 t1) 1000.))
;;get local time
(vlax-invoke wrap 'Register "MSVCR70" "ctime" "i=p" "r=s")
(setq pTime (vlax-invoke wrap 'malloc 4))
(vlax-invoke wrap 'NumPut (vlax-invoke wrap 'time 0) pTime)
(setq sTime (vlax-invoke wrap 'ctime pTime))
(vlax-invoke wrap 'free pTime)
(vlax-release-object wrap)And here is my example (VBS), I wish get some advice .
Option Explicit
'************************************
'* Sample GUI only with API calls *
'* Need DynamicWrapper component *
'* syntax Win NT et > *
'* highflybird March 2011 *
'************************************
' Window Messages
private Const WM_CREATE = &H1
private Const WM_DESTROY = &H2
private Const WM_MOVE = &H3
private Const WM_SIZE = &H5
private Const WM_ACTIVATE = &H6
private const WM_PAINT = &HF
private const WM_CLOSE = &H10
private const WM_QUIT = &H12
' other
Private Const DT_CENTER = &H1
Private Const DT_VCENTER = &H4
Private Const DT_SINGLELINE = &H20
Private Const CW_USEDEFAULT = &H80000000
' Create a object instance and Register some API functions
Dim DX
Set DX = CreateObject("DynamicWrapperX")
With DX
.Register "user32.dll","CreateWindowEx","i=lsslllllllll","r=l"
.Register "user32.dll","GetMessage","i=llll","r=l"
.Register "user32.dll","DispatchMessage","i=p","r=l"
.Register "user32.dll","TranslateMessage","i=p","r=l"
.Register "user32.dll","PostQuitMessage","i=l"
.Register "user32.dll","GetWindowLong","i=ll","r=l"
.Register "user32.dll","SendMessage","i=llll","r=l"
.Register "user32.dll","DefWindowProc","i=hlll","r=l"
.Register "user32.dll","SetWindowLong","i=lll","r=l"
.Register "user32.dll","GetWindowLong","i=ll","r=l"
.Register "user32.dll","SetLayeredWindowAttributes","i=hlbl","r=l"
.Register "user32.dll","BeginPaint","i=lp","r=l"
.Register "user32.dll","EndPaint","i=lp","r=l"
.Register "user32.dll","GetClientRect","i=lp","r=l"
.Register "user32.dll","DrawText","i=lslpl","r=l"
.Register "user32.dll","FillRect","i=lpl","r=l"
.Register "user32.dll","GetDC","i=l","r=l"
.Register "user32.dll","ShowWindow","i=ll","r=l"
.Register "user32.dll","UpdateWindow","i=l","r=l"
.Register "user32.dll","ReleaseDC","i=ll","r=l"
.Register "kernel32","LoadLibrary" ,"i=s" ,"r=l"
.Register "kernel32","FreeLibrary" ,"i=l" ,"r=l"
.Register "kernel32","GetProcAddress","i=ls","r=l"
.Register "MSVCR70.dll","malloc","i=l","r=l"
.Register "MSVCR70.dll","calloc","i=ll","r=l"
.Register "MSVCR70.dll","free","i=l"
.Register "gdi32.dll","CreateSolidBrush","i=l","r=l"
.Register "gdi32.dll","GetStockObject","i=l","r=l"
.Register "gdi32.dll","DeleteObject","i=l","r=l"
End With
Dim MSG
Dim ps
Dim rec
Dim FillArea
' alloc memory for pointers
MSG = DX.malloc (28) 'get a pointer for Message Struct
ps = DX.malloc(30) 'get a pointer for Paint Struct
rec = DX.malloc(16) 'get a pointer for RECT struct
FillArea = DX.calloc(4,4)
' Create a dialog
Dim hwnd
hwnd = DX.CreateWindowEx (256,"#32770","DynTest",349110272,CW_USEDEFAULT,CW_USEDEFAULT,400,300,0,0,0,0)
' Change some attributes of this window
Dim Ref
Dim pFunc
Dim ret
Dim hDC
Set Ref = GetRef("WndProc") 'Get the address of Callback function
pFunc = DX.RegisterCallback(Ref, "i=hlll", "r=l") 'the pointer of callback
ret = DX.SetWindowLong (hwnd,-4,pFunc)
ret = DX.SetWindowLong (hwnd,-20,524544) 'add a layer attribute
ret = DX.SetLayeredWindowAttributes (hwnd,0,192,2) 'transparent window
Call DX.GetClientRect(hwnd,rec) 'Get client rectangle
hDC = DX.GetDC(hwnd) 'Get a device context
Call DX.ShowWindow(hwnd,1)
Call DX.UpdateWindow(hwnd)
Call Form_Paint(DX,hDC,rec,FillArea)
' Deal with all kind of message
While DX.GetMessage (MSG,0,0,0)
DX.TranslateMessage (MSG)
DX.DispatchMessage (MSG)
Wend
' Release the device context and free memory
ret = DX.ReleaseDC(hwnd,hDC)
DX.free(MSG)
DX.free(ps)
DX.free(rec)
DX.free(FillArea) '
Set DX = nothing
Call MsgBox("Successful!",,"API in VBS")
' Callback function
Function WndProc(hwnd,umsg,wParam,lParam)
Select Case umsg
Case WM_DESTROY:
Call DX.PostQuitMessage(0)
Case WM_PAINT:
hDC= DX.BeginPaint(hwnd,ps)
Call DX.GetClientRect(hwnd,rec)
Call Form_Paint(DX,hDC,rec,FillArea)
Call DX.DrawText(hDC, "Hi,flying bird!", -1, rec, DT_SINGLELINE Or DT_CENTER Or DT_VCENTER)
Call DX.EndPaint(hwnd,ps)
Case Else:
End Select
WndProc = DX.DefWindowProc(hwnd,umsg,wParam,lParam)
End Function
' 用渐变背景绘制窗口
' A gradient window
Private Sub Form_Paint(DX,hDC,rec,FillArea)
Dim Color
Dim hBrush
Dim RetVal
Dim StepSize
Dim X
Dim ret
Dim bottom
bottom = DX.NumGet(rec,12)
StepSize = CLng(1 + bottom / 64)
Color = 255
RetVal = DX.NumPut(0,FillArea ,0)
RetVal = DX.NumGet(rec,8)
RetVal = DX.NumPut(RetVal,FillArea ,8)
RetVal = DX.NumPut(0,FillArea,4)
RetVal = DX.NumPut(StepSize,FillArea,12)
For X = 0 To 63
hBrush = DX.CreateSolidBrush(RGB(0, 255 - Color, Color))
RetVal = DX.FillRect(hDC, FillArea, hBrush)
RetVal = DX.DeleteObject(hBrush)
Color = Color - 4
If Color < 0 Then Color = 0
bottom = DX.NumGet(FillArea,12)
RetVal = DX.NumPut(bottom,FillArea,4)
RetVal = DX.NumPut(bottom+StepSize,FillArea,12)
Next
End Sub
Well, if the problem is with these lines:
.Register "MSVCR70.dll","malloc","i=l","r=l"
.Register "MSVCR70.dll","calloc","i=ll","r=l"
.Register "MSVCR70.dll","free","i=l"then the system just can't find MSVCR70.dll. Specify the full path to it. Or use "msvcrt.dll" instead. I used it, and your code worked for me.
Yes,you are right. I should consider this.
Could I say : "StrPtr" is safer than "malloc" ?
So, now we can add some "C" language or assembly language or other language ,it is really wonderful!:) 
Could I say : "StrPtr" is safer than "malloc" ?
Safer? I don't think so. Or maybe I don't understand what you mean?
So, now we can add some "C" language or assembly language or other language
Yes, if the functions use stdcall or cdecl calling convention. That's true for the Windows API functions, but if you take a DLL from somewhere else, it may be not so.
I mean: when I use these methods in a program , I found , "malloc" method makes program unstable,and will ruin my CAD,but "StrPtr" method works well.
So I want to know the reason.
I don't think malloc by itself should ruin anything. Perhaps you allocate not enough memory for structures. For example, in the above VBS code you allocate 30 bytes for a PAINTSTRUCT, but it actually needs 64.
em, I will check my code.thanks your mention.
I found the reason. This time prooved that, use DynamicWrapper, we should beware of the difference "A",and "W" .
In the program I mentioned, I used "WIN32_FIND_DATA" struct, I thought "WIN32_FIND_DATA" was 320 byte,so I used :
(vlax-invoke wrap 'malloc 320),
but acutally, it would be a "WIN32_FIND_DATAW" struct, it shoud be 592:
(vlax-invoke wrap 'malloc 592),
so it ruined CAD.
Now is my question:
1. After we get a buffer with "StrPtr" method ,we should free the buffer explicitly?
2. What's the different between "StrPtr" method and "malloc"?
3. Is there some different between "wrap.NumGet(pBuff, 0)" and "wrap.NumGet(pBuff)"?
Thanks a lot.
another question: how can I put a string to a buffer ?
when I used a "LPSHFILEOPSTRUCT",I occured some problems.
(vlax-invoke wrap 'NumPut sName pSHFileOp 8 "s")
;or
(vlax-invoke wrap 'NumPut sName pSHFileOp 8 "w")then
error: type dismatch.
Sorry, I am just a beginner. I wish it wouldn't bother you.
This time prooved that, use DynamicWrapper, we should beware of the difference "A",and "W" .
Yes, you should check it out.
1. After we get a buffer with "StrPtr" method ,we should free the buffer explicitly?
No. The buffer here is the memory allocated for the string variable by the script engine. The engine will take care of it.
2. What's the different between "StrPtr" method and "malloc"?
Memory allocated with malloc is not controlled by the script engine.
3. Is there some different between "wrap.NumGet(pBuff, 0)" and "wrap.NumGet(pBuff)"?
No difference. The offset is 0 by default.
another question: how can I put a string to a buffer ?
when I used a "LPSHFILEOPSTRUCT",I occured some problems.(vlax-invoke wrap 'NumPut sName pSHFileOp 8 "s") ;or (vlax-invoke wrap 'NumPut sName pSHFileOp 8 "w")then
error: type dismatch.
NumPut works for numbers only. If by "string" you mean a pointer to a string, then write it as a number. I.e. get a pointer through StrPtr and use types "p", "l", or "u" in NumPut.
Sorry, I am just a beginner. I wish it wouldn't bother you.
No, it's not bothering me.
when I used this plugin in my VBA (a vb application in CAD)
I add some code in a module:
pFunc = DX.RegisterCallback(AddressOf WndProc, "i=llll", "r=l")But it'll pop a messagebox :
Run-time error '-2147417848 (80010108)
Automatic error
the object invoked has disconnected its clients.
but I didn't use "RegisterCallback",just used the adress directly
Call SetWindowLong(DCLwnd, -4, AddressOf WndProc)then it would ruin CAD.
So, what I should do?
What type is "AddressOf WndProc"? How do you get it? If it's a script function reference, then maybe functions in this language differ in behaviour from those in JScript and VBScript, with which I only tested RegisterCallback. The error, unfortunately, tells me nothing, I've never seen such one before.
The type is "long" integer.addressof is a reserved word. I didn't finish the test. If I have the same problem later,I will tell you.
Yes,It's different.
"Long" won't work with RegisterCallback. In JScript and VBScript, functions are objects, so RegisterCallback expects a reference to an object (IDispatch interface) as its first parameter.
Hi,Dear Sir:
Long time no see.
Thanks your help. now I want to know this problem:
Can I create a multithreading program by this dll?
If I can ,how to do it?Or maybe show me a simple example?
thank you a lot.
Can I create a multithreading program by this dll?
No, I'm afraid you can't.
Thank your reply. I got it.
I tested it many times,but all failed,so now I know the reason.
I am having difficulty using dynwrapx dll. Is there any restriction that we cannot call managed c++ dll function using dynwrapx dll?
How these functions are being exported, by ordinals or by names?
I am using Java script for front end and the functions are being exported by names.
I am using Java script for front end and the functions are being exported by names.
Could you give an example of a name, you have problem with.
I will describe complete scenario.
There is one vendor who has developed a front end application. It is using dynwrapx dll for calling my dll function in the front end. My device dll are created using managed c++ and the vendor required it in plain c++. Hence we created a wrapper dll through which we simply call the managed c++ device dll.
below are the dll's and functions of dll
Card reader dll:-
unsigned char* SwipeCard();
Pin Pad dll:-
unsigned char* DownloadWorkKey(char*);
unsigned char* genPinBlock(char*);
When DownloadWorkKey function called and executed, the application calls SwipeCard function. here while calling DX.Register() function I am getting an exception.
Actually, i can'n see the problem.
Ok, i have to go, i'll try to help you on Monday.
Hi, could you upload you dll or create an example dll with such function's names.
<html>
<script language="javascript">
function Transmit_click(){
try{
DX = new ActiveXObject("DynamicWrapperX"); // Create an object instance.
//DY = new ActiveXObject("DynamicWrapperX"); // Create an object instance.
alert("Initialising DLLPath");
var DLLPath="";
try{
var wshshell = new ActiveXObject("wscript.shell");
DLLPath = wshshell.ExpandEnvironmentStrings("%DLLPATH1%");
}catch(err){
alert("Error in getting DLL Path "+err.description);
}
alert("Swipe your Card");
//This is the new DLL with only CardReader Code For SanyoCard Reader
//DX.Register(DLLPath+"/kioskCardReader", "SwipeCard", "r=s"); // This function has no parameters.
alert("kioskCardReader from "+DLLPath+"/kioskCardReader")
//This is the new DLL with only CardReader Code For CRT Card Reader
DX.Register(DLLPath+"/kioskCardReader", "SwipeCard", "r=s"); // This function has no parameters.
alert("1");
DX.Register(DLLPath+"/kioskPinPad", "DownloadWorkKey", "i=s","r=s");
alert("2");
DX.Register(DLLPath+"/kioskPinPad", "GenPinBlock", "i=ss","r=s");
//This is the Old DLL with Integration CardReader and PinPad Code
//DX.Register(DLLPath+"/NEWDLL_TEST/KioskCardVerify", "SwipeCard", "r=s"); // This function has no parameters.
alert("3");
KeyLoadFlag = DX.DownloadWorkKey("628ABAF46249F173");
alert(KeyLoadFlag);
alert("Before Calling kioskCardReader from "+DLLPath+"/kioskCardReader");
CardDetails = DX.SwipeCard();
alert("After Calling kioskCardReader");
alert(CardDetails);
//CardDetails = "6220180080000133217|4901|6220180080000133217D49011018620000000|Dhivya C |10081567";
alert("Enter PIN");
PinBlock = DX.GenPinBlock("",CardDetails);
alert("6");
alert(PinBlock);
}catch(err){alert("Error "+err.description);}
}
</script>
<body class="bodycolor" onload="Transmit_click()">
</body></html>This is the calling mechanism of the application which calls my dll's
I meant, your dll, otherwise, how i can solve the problem?
do you want full solution file, or just the dll code?
do you want full solution file, or just the dll code?
just dll file - kioskCardReader.dll
Mahesh Kulkarni
What kind of error are you getting? What exactly happens? On which line of the script you posted above does the error occur?
Mahesh Kulkarni
What kind of error are you getting? What exactly happens? On which line of the script you posted above does the error occur?
Hi,YMP:
Nice to see you again.
I got a problem , "DynamicWrapperX" can't run in x64 system. So, Is there anyway or a new version can run in x64?
Thank you very much.
Best regard.
highflybird
It can work on a 64-bit system if the process using it is 32-bit. At least it works on my Win7/64. No, there isn't a new version. I started rewriting Dynwrapx a few months ago, but later my interest in this project decreased and I dropped it.
YMP:
Sorry for reply so late.
Thanks. Unfortunately, my process is 64-bit. This one doesn't work on my Win7/64.
I look forward to a new version coming.
Thank you so much.
Best regard.
highflybird
It can work on a 64-bit system if the process using it is 32-bit. At least it works on my Win7/64. No, there isn't a new version. I started rewriting Dynwrapx a few months ago, but later my interest in this project decreased and I dropped it.
Hello there.
Are there any chanses that your interest will increase again?
As for me, that would be great to have wrapper which is able to work on x64 natively.
rhf
Yes, I am working on it now. Or rather I have started to get familiar with the peculiarities of 64-bit assembly. First I have to convert the script editor in which I run my scripts so later I could conveniently test Dynwrapx x64 in it. I mean it will take some time to get to converting Dynwrapx itself, but I am sure it will be done this year.
Have you thought of any new features that you think are worth adding?
rhf
Yes, I am working on it now. Or rather I have started to get familiar with the peculiarities of 64-bit assembly. First I have to convert the script editor in which I run my scripts so later I could conveniently test Dynwrapx x64 in it. I mean it will take some time to get to converting Dynwrapx itself, but I am sure it will be done this year.Have you thought of any new features that you think are worth adding?
I am waiting for you.Thanks your hard work!
highflybird
The work has stopped for a while. Not sure when I'll be able to resume and finish it. I now have a working 64-bit version, but it's in a half-baked state, so to speak. There are some decisions I have to make about its functionality, some issues I have to resolve, and also I'll have to test it thoroughly. So I can't promise it'll be ready soon, sorry.
highflybird
The work has stopped for a while. Not sure when I'll be able to resume and finish it. I now have a working 64-bit version, but it's in a half-baked state, so to speak. There are some decisions I have to make about its functionality, some issues I have to resolve, and also I'll have to test it thoroughly. So I can't promise it'll be ready soon, sorry.
Очень-очень жаль! Думаю, очень многие, и я в том числе, надеются, что вы продолжите работу над DynamicWrapperX x64.
janxp
Да, надо продолжать. Проблема-то, в общем, тривиальна: конвертировать было интересно, а вот тщательная проверка кода и отлов багов — нудное занятие, поэтому всё время откладываю.
xxx: да не, написал я её быстро. Потом просто больше часа дебагил...
yyy: оно что-то не то выдавало?
xxx: не, оно выдало что надо с первого раза, это меня и насторожило...
Страницы 1
Чтобы отправить ответ, вы должны войти или зарегистрироваться
