需要用到 DynaWrapper 组件，使用前先 regsvr32 dynwrap.dll 。附件里的vbs可以直接运行，我已经加了一句，呵呵

Option Explicit'************************************'* Sample GUI only with API calls *'* Need DynaWrap component *'* Use Struct v1.1 Class *'* syntax Win NT et > *'* omen999 february 2007 *'************************************

Class Struct ' v1.1 allow typedef with dynawrap callsPublic Property Get Ptr '******************************* Property PtrPtr=GetBSTRPtr(sBuf)End PropertyPublic Sub Add(sItem,sType,Data) '********************** Method AddDim lVSize,iA,iB,iDiA=InStr(1,sType,"[",1)iB=InStr(1,sType,"]",1)iD="0"If iA>0 And iB>0 TheniD=Mid(sType,iA+1,iB-iA-1)If isNumeric(iD) ThensType=Left(sType,iA-1)ElseErr.raise 10000,"Method Add","The index " & iD & " must be numeric"Exit SubEnd IfEnd IfSelect Case UCase(sType)'************************************************* COMPLETE WITH OTHERS WIN32 TYPES'OS 32bits...Case "DWORD","LONG","WPARAM","LPARAM","POINTX","POINTY","ULONG","HANDLE","HWND","HINSTANCE","HDC","WNDPROC","HICON","HCURSOR","HBRUSH"lVSize=4Case "LPBYTE","LPCTSTR","LPSTR","LPPRINTHOOKPROC","LPSETUPHOOKPROC","LPVOID","INT","UINT"lVSize=4Case "WORD"lVSize=2Case "BYTE"lVSize=1Case "TCHAR"If CLng(iD)<1 Then lVSize="254" Else lVSize=iDCase ElseErr.raise 10000,"Method Add","The type " & sType & " is not a Win32 type."Exit SubEnd SelectdBuf.Add sItem,lVSizesBuf=sBuf & String(lVSize/2+1,Chr(0))SetDataBSTR GetBSTRPtr(sBuf),lVSize,Data,iOffsetEnd SubPublic Function GetItem(sItem) '********************************************** Méthode GetItemDim lOf,lSi,aItems,aKeys,iIf dBuf.Exists(sItem) thenlSi=CLng(dBuf.Item(sItem))aKeys=dBuf.KeysaItems=dBuf.ItemslOf=0For i=0 To dBuf.Count-1If aKeys(i)=sItem Then Exit ForlOf=lOf+aItems(i)NextGetItem=GetDataBSTR(Ptr,lSi,lOf)ElseGetItem=""err.raise 10000,"Method GetItem","The item " & sItem & " don't exist"End IfEnd FunctionPublic Function GetBSTRPtr(ByRef sData)'retun the TRUE address (variant long) of the sData string BSTRDim pSource Dim pDestIf VarType(sData)<>vbString Then 'little checkGetBSTRPtr=0err.raise 10000, "GetBSTRPtr", "The variable is not a string"Exit FunctionEnd IfpSource=oSCat.lstrcat(sData,"") 'trick to return sData pointerpDest=oSCat.lstrcat(GetBSTRPtr,"") 'idemGetBSTRPtr=CLng(0) 'cast function variable'l'adresse du contenu réel de sBuf (4octets) écrase le contenu de la variable GetBSTPtr 'les valeurs sont incrémentées de 8 octets pour tenir compte du Type DescriptoroMM.RtlMovememory pDest+8,pSource+8,4 End Function'**************************************************************************** IMPLEMENTATIONPrivate oMM,oSCat,oAnWi 'objets wrapper APIPrivate dBuf,sBuf,iOffset Private Sub Class_Initialize 'ConstructeurSet oMM=CreateObject("DynamicWrapper")oMM.Register "kernel32.dll","RtlMoveMemory","f=s","i=lll","r=l"Set oSCat=CreateObject("DynamicWrapper")oSCat.Register "kernel32.dll","lstrcat","f=s","i=ws","r=l" Set oAnWi=CreateObject("DynamicWrapper") oAnWi.Register "kernel32.dll","MultiByteToWideChar","f=s","i=llllll","r=l"Set dBuf=CreateObject("Scripting.Dictionary")sBuf=""iOffset=0End Sub Private Sub SetDataBSTR(lpData,iSize,Data,ByRef iOfs)'Place une valeur Data de taille iSize à l'adresse lpData+iOfsDim lW,hW,xBufSelect Case iSize 'on commence par formater les valeurs numériquesCase 1lW=Data mod 256 'formatage 8 bitsxBuf=ChrB(lW)Case 2 'if anylW=Data mod 65536 'formatage 16 bitsxBuf=ChrW(lW) 'formatage little-endianCase 4hW=Fix(Data/65536)'high wordlW=Data mod 65536 'low wordxBuf=ChrW(lW) & ChrW(hW) 'formatage little-endianCase Else 'bytes array, size iSizexBuf=DataEnd SelectoMM.RtlMovememory lpData+iOfs,GetBSTRPtr(xBuf),iSizeiOfs=iOfs+iSize 'maj l'offsetEnd SubPrivate Function GetDataBSTR(lpData,iSize,iOffset)'Read an iSize data to lpData+iOffset addressConst CP_ACP=0 'code ANSI Dim pDest,tdOffset'valeurs pour les données numériquespDest=oSCat.lstrcat(GetDataBSTR,"")tdOffset=8Select Case iSize ' cast de la variable fonctionCase 1GetDataBSTR=CByte(0)Case 2GetDataBSTR=CInt(0)Case 4GetDataBSTR=CLng(0)Case Else 'a little bit more complicated with string data...GetDataBSTR=String(iSize/2,Chr(0))'la chaine variant BSTR stocke ses données ailleurspDest=GetBSTRPtr(GetDataBSTR)tdOffset=0End Select'le contenu de la structure à l'offset iOffset écrase le contenu de la variable GetDataBSTR (tenir compte du TD)oMM.RtlMovememory pDest+tdOffset,lpData+iOffset,iSize if tdOffset=0 ThenoAnWi.MultiByteToWideChar CP_ACP,0,lpData+iOffset,-1,pDest,iSize 'don't forget conversion Ansi->WideGetDataBSTR=Replace(GetDataBSTR,Chr(0),"") 'clean the trailerEnd IfEnd Function End Class

Class XGui 'v1.0' this class create a dialogbox only by api calls ' it uses automation component DynaWrap and the struct class upper to allow typedef with dynawrap calls' 4 public methods: CreateForm, ShowForm, RunForm et AddControl' 1 public object dictionnary dFrmData which keys are name controls and stores data controls' edit, static et button controls return content, listbox/combobox the selected item if exists, or empty string' radiobutton and checkbox return true if checked or false' groupbox control always return false' each control must have unique name' if the last letter of a checkbox ou radiobutton control name is "k", the control wil be checked' close form without dictionnary data with esc key, Alt+F4, close button and system menu' button controls haven't default behavior et must be manage by RunForm method' this release 1.0 manages only "&ok" et "&cancel" buttons' button ok closes the form and set data dictionnary, button cancel acts like esc key

Public dFrmData ' object dictionnaryPublic Sub CreateForm(sCaption,lLeft,lTop,lWidth,lHeight,bOnTaskBar)'Create a modeless invisible form'sCaption: form caption'lLeft,lTop: coordinates form'lWidth, lHeight: form dimensions'bOnTaskBar: if true (-1) form is display on taskbar'no return value

Const WS_VISIBLE=&H10000000Const WS_POPUP=&H80000000Const WS_OVERLAPPEDWINDOW=&HCF0000Dim hTask,fChildIf bOnTaskBar ThenhTask=0fChild=0ElsehTask=hWshfChild=WS_CHILDEnd IfhWF=oWGui.CreateWindowExA(0,"#32770",sCaption&"",WS_OVERLAPPEDWINDOW+WS_POPUP+fChild,lLeft,lTop,lWidth,lHeight,hTask,0,hIns,0)End SubPublic Sub ShowForm(bAlwaysOnTop)'display the form created by CreateForm'bAlwaysOnTop: if true (-1) form always on top'no return value

Const HWND_TOP=0Const HWND_TOPMOST=-1Const SWP_SHOWWINDOW=&H40Const SWP_NOMOVE=&H2Const SWP_NOSIZE=&H1Dim fTopIf bAlwaysOnTop Then fTop=HWND_TOPMOST Else fTop=HWND_TOPoWGui.SetWindowPos hWF,fTop,0,0,0,0,SWP_SHOWWINDOW+SWP_NOMOVE+SWP_NOSIZEEnd SubPublic Sub RunForm()'form messages pump and dictionnary gestion'no return value

Const WM_COMMAND=&H111Const WM_SYSCOMMAND=&H112Const WM_KEYUP=&H101Const WM_LBUTTONUP=&H202Const GCW_ATOM=-32Const LB_GETCURSEL=&H188Const LB_ERR=-1Const LB_GETTEXT=&H189Const LB_GETTEXTLEN=&H18AConst GWL_STYLE=-16Const WS_CHILD=&H40000000Const WS_VISIBLE=&H10000000Const WS_TABSTOP=&H10000Const BS_AUTOCHECKBOX=&H3Const BS_AUTORADIOBUTTON=&H9Const BM_GETCHECK=&HF0Const BST_UNCHECKED=&H0Const BST_CHECKED=&H1Const BST_INDETERMINATE=&H2Const BST_PUSHED=&H4Const BST_FOCUS=&H8Const CP_ACP=0Const GWL_ID=-12Dim sCN,sCNW 'control content ansi/wideDim aKData,aHData 'dictionnary contents keys/datasDim lGetI 'index selected item (listbox)Dim lStyle 'button styleDim lKCode 'param messageDim n 'compteurDo While oWGui.GetMessageA(MSG.Ptr,hWF,0,0)>0 'Main loop messages pumpIf oWGui.IsDialogMessageA(hWF,MSG.ptr)<>0 ThenSelect Case MSG.GetItem("message")Case WM_KEYUP,WM_LBUTTONUPlKCode=MSG.GetItem("wParam")If MSG.GetItem("message")=WM_LBUTTONUP Then lKCode=13 'left mouse click -> enterkeySelect Case lKCode Case 27 'esc dFrmData.RemoveAlloWGui.DestroyWindow hWFExit DoCase 13,32 'enter or space when is an button controlIf oWGui.GetClassLongA(oWGui.GetFocus,GCW_ATOM)=49175 Then 'get atom buttonsCNW=UCase(GetBSTRCtrl(oWGui.GetFocus))If sCNW="&OK" Then 'it's ok button, so set dictionnary data and form closeaKData=dFrmData.Keys 'control names arrayaHData=dFrmData.Items 'control handles arrayFor n=0 To dFrmData.Count-1 'loopsCNW=""If oWGui.GetClassLongA(aHData(n),GCW_ATOM)=49178 Then 'get atom listboxlGetI=oWGui.SendMessageA(aHData(n),LB_GETCURSEL,0,0)If lGetI<>LB_ERR Then 'get the selected item if anysCN=String(127,Chr(0))sCNW=String(oWGui.SendMessageA(aHData(n),LB_GETTEXT,lGetI,MSG.GetBSTRPtr(sCN)),Chr(0))oWaw.MultiByteToWideChar CP_ACP,0,MSG.GetBSTRPtr(sCN),-1,MSG.GetBSTRPtr(sCNW),LenB(sCNW)End IfElseIf oWGui.GetClassLongA(aHData(n),GCW_ATOM)=49175 Then 'get atom buttonlStyle=oWGui.GetWindowLongA(aHData(n),GWL_STYLE)If ((lStyle And BS_AUTOCHECKBOX)=BS_AUTOCHECKBOX) Or ((lStyle And BS_AUTORADIOBUTTON)=BS_AUTORADIOBUTTON) ThensCNW=FalseIf oWGui.SendMessageA(aHData(n),BM_GETCHECK,0,0)=BST_CHECKED Then sCNW=TrueElse 'other pushboutonsCNW=GetBSTRCtrl(aHData(n))End IfElse 'get data for edit, combo, static...sCNW=GetBSTRCtrl(aHData(n))End IfEnd IfdFrmData.Item(aKData(n))=sCNW 'la majNextoWGui.DestroyWindow hWFExit DoEnd IfIf sCNW="&ANNULER" ThendFrmData.RemoveAlloWGui.DestroyWindow hWFExit DoEnd If End IfEnd SelectCase WM_COMMAND,WM_SYSCOMMANDIf (MSG.GetItem("wParam")=2) Or (MSG.GetItem("wParam")=61536) Then 'close button or system menudFrmData.RemoveAlloWGui.DestroyWindow hWFExit DoEnd IfEnd SelectElseoWGui.TranslateMessage MSG.PtroWGui.DispatchMessageA MSG.PtrEnd If Loop End SubPublic Sub AddControl(sName,sClass,sData,lLeft,lTop,lWidth,lHeight)'add a control on the form create by CreateForm method'sName: unique control name'sClass: one of global system class name'sData: control data'lLeft,lTop: control position on screen'lWidth, lHeight: control dimensions'no return valueConst WS_EX_CLIENTEDGE=&H200Const DEFAULT_GUI_FONT=17Const WM_SETFONT=&H30Const WS_CHILD=&H40000000Const WS_VISIBLE=&H10000000Const WS_TABSTOP=&H10000Const GWL_ID=-12Const WS_VSCROLL=&H200000Const BS_AUTOCHECKBOX=&H3Const BS_AUTORADIOBUTTON=&H9Const BS_GROUPBOX=&H7Const BM_SETCHECK=&HF1Const BST_CHECKED=1Const LBS_HASSTRINGS=&H40Const CBS_DROPDOWN=&H2Const CB_ADDSTRING=&H143Const LB_ADDSTRING=&H180Const LBS_DISABLENOSCROLL=&H1000Dim hWn 'current control handleDim sD 'current control dataDim cbBuf 'array list/combo dataDim sX 'types buttonsDim lStyle 'current control stylesDim lStyleEx 'extended styles Dim lSL 'style liste or comboDim fC 'flag checkDim fL 'flag listDim n 'loopfC=FalsefL=False'parameters definition for CreateWindowEx according to class controlSelect Case UCase(sClass)Case "EDIT"sX=sClasssD=sDatalStyle=WS_CHILD+WS_VISIBLE+WS_TABSTOPlStyleEx=WS_EX_CLIENTEDGECase "STATIC"sX=sClasssD=sDatalStyle=WS_CHILD+WS_VISIBLElStyleEx=0Case "COMBOBOX"sX=sClasssD=""lStyle=WS_CHILD+WS_VISIBLE+CBS_DROPDOWN+WS_TABSTOPlStyleEx=0cbBuf=Split(sData,"|")fL=True lSL=CB_ADDSTRINGCase "LISTBOX"sX=sClasssD=""lStyle=WS_CHILD+WS_VISIBLE+WS_TABSTOP+WS_VSCROLL+LBS_HASSTRINGS+LBS_DISABLENOSCROLLlStyleEx=WS_EX_CLIENTEDGEcbBuf=Split(sData,"|")fL=TruelSL=LB_ADDSTRINGCase "BUTTON"sX=sClasssD=sDatalStyle=WS_CHILD+WS_VISIBLE+WS_TABSTOPlStyleEx=0Case "GROUPBOX"sX="button"sD=sDatalStyle=WS_CHILD+WS_VISIBLE+BS_GROUPBOXlStyleEx=0Case "CHECKBOX"sX="button"sD=sDatalStyle=WS_CHILD+WS_VISIBLE+WS_TABSTOP+BS_AUTOCHECKBOXlStyleEx=0fC=TrueCase "RADIOBUTTON"sX="button"sD=sDatalStyle=WS_CHILD+WS_VISIBLE+WS_TABSTOP+BS_AUTORADIOBUTTONlStyleEx=0fC=TrueCase ElseErr.raise 10000,"Method AddControl","The class " & sClass & " is not a global system class"Exit SubEnd SelecthWn=oWGui.CreateWindowExA(lStyleEx,sX&"",sD&"",lStyle,lLeft,lTop,lWidth,lHeight,hWF,0,hIns,0) 'control creationoWGui.SendMessageA hWn,WM_SETFONT,oWGui.GetStockObject(DEFAULT_GUI_FONT),-1 'default fontIf fL Then 'feed the listbox/comboboxFor n=0 to UBound(cbBuf)oWsm.SendMessageA hWn,lSL,0,MSG.GetBSTRPtr(cbBuf(n))NextEnd IfIf fC Then 'check control with end's name is letter kIf UCase(Right(sName,1))="K" Then oWGui.SendMessageA hWn,BM_SETCHECK,BST_CHECKED,0End IfdFrmData.Add sName,hWn 'add control handle to dictionnaryEnd Sub'************************************************************************************************************* IMPLEMENTATIONPrivate oWGui 'object API GUIPrivate oWsm 'object SendMessage (syntax different)Private oWaw 'object ANSI -> UNICODE conversion

Private MSG 'structure MSG from APIPrivate hIns 'instance handlePrivate hWsh 'main window WScript handle (hidden)Private hWF 'form handle

Private Sub Class_Initialize 'ConstructorConst GWL_HINSTANCE=-6Set oWGui=CreateObject("DynamicWrapper")Set oWsm=CreateObject("DynamicWrapper")Set oWaw=CreateObject("DynamicWrapper")With oWGui.Register "user32.dll","FindWindowA","f=s","i=ss","r=l".Register "user32.dll","CreateWindowExA","f=s","i=lsslllllllll","r=l".Register "user32.dll","SetWindowPos","f=s","i=lllllll","r=l".Register "user32.dll","GetMessageA","f=s","i=llll","r=l".Register "user32.dll","DispatchMessageA","f=s","i=l","r=l".Register "user32.dll","TranslateMessage","i=l","f=s","r=l".Register "user32.dll","GetWindowLongA","f=s","i=ll","r=l".Register "user32.dll","SendMessageA","f=s","i=llll","r=l".Register "user32.dll","SetWindowLongA","f=s","i=lll","r=l".Register "user32.dll","GetWindowLongA","f=s","i=ll","r=l".Register "user32.dll","IsDialogMessageA","f=s","i=ll","r=l".Register "user32.dll","DestroyWindow","f=s","i=l","r=l".Register "user32.dll","GetFocus","f=s","r=l".Register "user32.dll","GetWindowTextA","f=s","i=lll","r=l".Register "user32.dll","GetWindowTextLengthA","f=s","i=l","r=l".Register "user32.dll","GetClassLongA","f=s","i=ll","r=l".Register "gdi32.dll","GetStockObject","f=s","i=l","r=l"End WithoWsm.Register "user32.dll","SendMessageA","f=s","i=llls","r=l" 'dioWaw.Register "kernel32.dll","MultiByteToWideChar","f=s","i=llllll","r=l"Set MSG=New StructWith MSG.Add "hwnd","HWND",0 .Add "message","UINT",0.Add "wParam","WPARAM",0.Add "lParam","LPARAM",0.Add "time","DWORD",0.Add "ptx","POINTX",0.Add "pty","POINTY",0End WithSet dFrmData=CreateObject("Scripting.Dictionary")hWsh=oWGui.FindWindowA("WSH-Timer",chr(0))hIns=oWGui.GetWindowLongA(hWsh,GWL_HINSTANCE) End SubPrivate Function GetBSTRCtrl(hdW)' Return handle hdW control content as string BSTRConst CP_ACP=0Dim sBuf,sBufWsBuf=String(oWGui.GetWindowTextLengthA(hdW),Chr(0)) sBufW=String(oWGui.GetWindowTextA(hdW,MSG.GetBSTRPtr(sBuf),oWGui.GetWindowTextLengthA(hdW)+1),Chr(0))oWaw.MultiByteToWideChar CP_ACP,0,MSG.GetBSTRPtr(sBuf),-1,MSG.GetBSTRPtr(sBufW),LenB(sBufW)GetBSTRCtrl=sBufWEnd FunctionEnd Class

'************************************************************************* DialogBox SAMPLE

Dim oFrmSet oFrm=New XGuioFrm.CreateForm "DialogBox by omen999",150,300,480,300,-1 ' modeless formoFrm.AddControl "label1","static","&Last Name :",10,8,60,16oFrm.AddControl "edit1","edit","",10,26,120,20oFrm.AddControl "label2","static","&First Name :",10,50,60,16oFrm.AddControl "edit2","edit","",10,68,120,20oFrm.AddControl "label3","static","A&ddress :",10,94,100,16oFrm.AddControl "edit3","edit","",10,112,150,20oFrm.AddControl "label4","static","&City :",10,136,100,20oFrm.AddControl "edit4","edit","",10,152,100,20oFrm.AddControl "gbox1","groupbox"," Sex ",6,178,84,72oFrm.AddControl "rdbox1","radiobutton","&Male",10,194,68,18oFrm.AddControl "rdbox2k","radiobutton","&Female",10,212,68,18 'this control will be checkedoFrm.AddControl "rdbox3","radiobutton","&Don't know",10,230,74,18oFrm.AddControl "label5","static","&Status :",146,8,40,16oFrm.AddControl "cbox1","combobox","single|married|divorcee",146,26,150,80oFrm.AddControl "label6","static","&Type :",310,8,40,16oFrm.AddControl "lbox1","listbox","anorexic|very thin|thin|normal|fat|obese|dead",310,28,150,80oFrm.AddControl "ckbox1k","checkbox","Mem&ber",310,90,68,20 'this control will be checkedoFrm.AddControl "button1","button","&OK",392,240,70,24oFrm.AddControl "button2","button","&Cancel",312,240,70,24oFrm.ShowForm FalseoFrm.RunForm 'messages pump

'display the dialogbox final contentMsgBox oFrm.dFrmData.Item("label1") & vbLf &_oFrm.dFrmData.Item("edit1") & vbLf &_oFrm.dFrmData.Item("label2") & vbLf &_oFrm.dFrmData.Item("edit2") & vbLf &_oFrm.dFrmData.Item("label3") & vbLf &_oFrm.dFrmData.Item("edit3") & vbLf &_oFrm.dFrmData.Item("label4") & vbLf &_oFrm.dFrmData.Item("edit4") & vbLf &_oFrm.dFrmData.Item("gbox1") & vbLf &_oFrm.dFrmData.Item("rdbox1") & vbLf &_oFrm.dFrmData.Item("rdbox2k") & vbLf &_oFrm.dFrmData.Item("rdbox3") & vbLf &_oFrm.dFrmData.Item("label5") & vbLf &_oFrm.dFrmData.Item("cbox1") & vbLf &_oFrm.dFrmData.Item("label6") & vbLf &_oFrm.dFrmData.Item("lbox1") & vbLf &_oFrm.dFrmData.Item("ckbox1k") & vbLf &_oFrm.dFrmData.Item("button1") & vbLf &_oFrm.dFrmData.Item("button2")