Esta sección te permite ver todos los mensajes escritos por este usuario. Ten en cuenta que sólo puedes ver los mensajes escritos en zonas a las que tienes acceso en este momento.
Cita de: agus0 en 12 Noviembre 2010, 03:46 AM
Busque algo en PSC no se mucho ingles,, pero lo que encontré usan OCX que es paga y si no manipulan el OutLook... y bueno eso...
Si alguien tiene algún Source o encuentra uno Me vendría bien. para buscar en PSC puse "Read Mail"
& "·$%&/(" & Archivo & "·$%&/(" &
Dim StrRes as string
StrRes = variable1 & "Hola" & Archivo & "Adios" & Variable2
Cita de: BlackZeroX▓▓▒▒░░ en 19 Julio 2010, 08:19 AM
Mira aquí hay un ejemplo de un DLL que puede tratarse como Plugin, ya que l forma de hacer por comunicacion de archivos de texto no va de muy grata forma xP:
http://infrangelux.sytes.net/filex/?file=/BlackZeroX/Proyectos/Proyecto%20InfraExplorer/SRC_ExamplePlugin.rar&modo=2&dir=/BlackZeroX/Proyectos/Proyecto%20InfraExplorer&;
Lo que debes saber para tratar una DLL como plugin es que:
Nombre del proyecto = que el Nombre de la DLL ( si tu proyecto se llama Proyect1 tu DLL debera llamarse Proyect1.dll)
El nombre de los módulos de clase da igual, pero estos son usados para crear el Objeto con CreateObject()!¡.
Deben estar registrados con RegServ32
compila y con este código puedes correr un proceso X
El Siguiente código esta Orientado en el source qué te puse arriba ok!¡.Código (vb) [Seleccionar]
' by BlackZeroX.
' Antes debes generar el Plugin "PluginExplicit" y registrarlo con RegServ32 (Solo en equipos donde NO SE COMPILO!¡.)
Dim ObjPlugin as Object
set ObjPlugin = createobject("PluginExplicit.cMain") ' // cMain es el nombre del Modulo de Clase!¡.
with ObjPlugin
call .WSConnect ' // ejecuta el proceso deseado
msgbox .Nombre
msgbox .Version
msgbox .ProcesoUno("") ' // proceso con parámetros en este caso e sun ParamArray xP
msgbox .ProcesoDos("","","") ' // proceso con parámetros en este caso e sun ParamArray xP
msgbox .ProcesoTres("","","") ' // proceso con parámetros en este caso e sun ParamArray xP
CMain=nothing ' // le puedes espesificar un Objeto para que el plugin trabaje con este!¡.
end with
set ObjPlugin = nothing ' // hay que descargarlo cuando ya no este en uso si no la memoria uff xS
la alternativa a CreateObject es CreateFromFile esta en PSC el modulo, y se trata de la misma manera, y hasta donde recuerdo este ultimo no nesesita que la DLL o plugin este registrado con RegServ32!¡.
Sangriento Infierno Lunar!¡.
Private Type st
ss As String
ll As Long
End Type
Private Sub Form_Load()
Dim stt As st
' // [ stt.ss ] Cada caracter esta separado por un "chr(0)" y _
solo por esto cada caracter = 2 bytes en este caso son 12 bytes
stt.ss = "aaaaaa"
stt.ll = 500
' // [ len() ] La estructura consta de 2 parametros por asi decirlo _
y uno de ellos es Un "String" de longitud No declarada _
entonces esto significa que en ese lugar hay Un puntero a el primer digito _
de la "string" es decir en otra parte de la memoria esta la "String". _
mientras que el tipo "long" ya se sabe que son 4 bytes por ende No se _
nesesita crear en otra parte es decir son 8 bytes de la estructura _
y solo uno de los campos es "String" de longitud NO DECLARADA _
por ende es creado en otra parte, y sustituido po su puntero al mismo!¡.
MsgBox Len(stt) + LenB(stt.ss) - 4 ' // El 4 es el puntero al string
' // (4 bytes = long) + LenB(stt.ss) = bytes Reales
' // Es decir en este caso: _
4 + 6*2 -4 ( ya que el primer 4 es long, El 6*2 es que son 4 caracteres pero cada _
caracter termina por Until chr(0) por eso es por 2 ) y el -4 es el puntero Dela estructura.
End Sub
Private Type st
ss As String
ll As Long
End Type
Dim a as st
dim lng_ptr as long
lng_ptr = Varptr(a) ' <--- Puntero a la estructura es decir 4 bytes de tipo long
Option Explicit
Private Type Estruct1
st1 As String
in1 As Long
st2 As String
End Type
Private Type Estruct2
st1 As String
in1 As Long
st2 As String
in2 As Long
st3 As String
End Type
Private Sub Form_Load()
Dim st1 As Estruct1
Dim st2 As Estruct2
Dim S As String
S = "BlackZeroX"
st1.st1 = "infrangelux"
Call SwapPtr(VarPtr(S), VarPtr(st1.st1), 4)
Call SwapPtr(VarPtr(st1.st1), VarPtr(st2.st3), 4)
MsgBox S
MsgBox st1.st1
MsgBox st2.st3
End Sub
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal Destination As Any, ByVal Source As Any, ByVal Length As Long)
Public Sub SwapPtr(ByVal lngPtrOne As Long, ByVal lngPtrTwo As Long, Optional LenOFStructure As Long = 4)
If LenOFStructure < 1 Then Exit Sub
Dim Byt_Bytes() As Long
ReDim Byt_Bytes(1 To LenOFStructure)
Call CopyMemory(ByVal VarPtr(Byt_Bytes(1)), ByVal lngPtrOne, LenOFStructure)
Call CopyMemory(ByVal lngPtrOne, ByVal lngPtrTwo, LenOFStructure)
Call CopyMemory(ByVal lngPtrTwo, ByVal VarPtr(Byt_Bytes(1)), LenOFStructure)
End Sub
Option Explicit
'[rm_code]
'CodeId=64499
Private Declare Function CallWindowProc Lib "user32" _
Alias "CallWindowProcA" ( _
ByVal adr As Long, _
ByVal p1 As Long, _
ByVal p2 As Long, _
ByVal p3 As Long, _
ByVal p4 As Long _
) As Long
Private Declare Function LoadLibrary Lib "kernel32" _
Alias "LoadLibraryA" ( _
ByVal szLib As String _
) As Long
Private Declare Function GetProcAddress Lib "kernel32" ( _
ByVal hModule As Long, _
ByVal szFnc As String _
) As Long
Private Declare Function GetModuleHandle Lib "kernel32" _
Alias "GetModuleHandleA" ( _
ByVal szModule As String _
) As Long
Private Declare Function LoadTypeLibEx Lib "oleaut32" ( _
ByVal szFile As Long, _
ByVal REGKIND As Long, _
pptlib As Any _
) As Long
Private Declare Function StringFromGUID2 Lib "ole32" ( _
tGuid As Any, _
ByVal lpszString As String, _
ByVal lMax As Long _
) As Long
Private Declare Sub CpyMem Lib "kernel32" _
Alias "RtlMoveMemory" ( _
pDst As Any, _
pSrc As Any, _
ByVal dlen As Long _
)
Private Type IUnknown
QueryInterface As Long
AddRef As Long
Release As Long
End Type
Private Type IClassFactory
IUnk As IUnknown
CreateInstance As Long
Lock As Long
End Type
Private Type ITypeInfo
IUnk As IUnknown
GetTypeAttr As Long
GetTypeComp As Long
GetFuncDesc As Long
GetVarDesc As Long
GetNames As Long
GetRefTypeOfImplType As Long
GetImplTypeFlags As Long
GetIDsOfNames As Long
Invoke As Long
GetDocumentation As Long
GetDllEntry As Long
GetRefTypeInfo As Long
AddressOfMember As Long
CreateInstance As Long
GetMops As Long
GetContainingTypeLib As Long
ReleaseTypeAttr As Long
ReleaseFuncDesc As Long
ReleaseVarDesc As Long
End Type
Private Type ITypeLib
IUnk As IUnknown
GetTypeInfoCount As Long
GetTypeInfo As Long
GetTypeInfoType As Long
GetTypeInfoOfGuid As Long
GetLibAttr As Long
GetTypeComp As Long
GetDocumentation As Long
IsName As Long
FindName As Long
ReleaseTLibAttr As Long
End Type
Private Type TYPEATTR
guid(15) As Byte
lcid As Long
dwReserved As Long
memidConstructor As Long
memidDestructor As Long
pstrSchema As Long
cbSizeInstance As Long
TYPEKIND As Long
cFuncs As Integer
cVars As Integer
cImplTypes As Integer
cbSizeVft As Integer
cbAlignment As Integer
wTypeFlags As Integer
wMajorVerNum As Integer
wMinorVerNum As Integer
tdescAlias As Long
idldescType As Long
End Type
Private Enum TYPEKIND
TKIND_ENUM
TKIND_RECORD
TKIND_MODULE
TKIND_INTERFACE
TKIND_DISPATCH
TKIND_COCLASS
TKIND_ALIAS
TKIND_UNION
TKIND_MAX
End Enum
Private Enum HRESULT
S_OK = 0
End Enum
Private Type CoClass
Name As String
guid() As Byte
End Type
Private Type guid
data1 As Long
data2 As Integer
data3 As Integer
data4(7) As Byte
End Type
Private Enum REGKIND
REGKIND_DEFAULT
REGKIND_REGISTER
REGKIND_NONE
End Enum
Public Function CreateObjectFromFile( _
ByVal strLibrary As String, _
ByVal strClassName As String _
) As stdole.IUnknown
Dim newobj As stdole.IUnknown
Dim udtCF As IClassFactory
Dim classid As guid
Dim IID_ClassFactory As guid
Dim IID_IUnknown As guid
Dim lib As String
Dim obj As Long
Dim vtbl As Long
Dim hModule As Long
Dim pFunc As Long
Dim udtCoCls() As CoClass
Dim i As Long
With IID_ClassFactory
.data1 = &H1
.data4(0) = &HC0
.data4(7) = &H46
End With
With IID_IUnknown
.data4(0) = &HC0
.data4(7) = &H46
End With
' get all CoClasses from the type lib of
' the file, and find the GUID of the Prog ID
If Not GetCoClasses(strLibrary, udtCoCls) Then
Exit Function
End If
For i = 0 To UBound(udtCoCls)
If StrComp(udtCoCls(i).Name, strClassName, vbTextCompare) = 0 Then
CpyMem classid, udtCoCls(i).guid(0), Len(classid)
Exit For
End If
Next
If i = UBound(udtCoCls) + 1 Then
Exit Function
End If
' load the file, if it isn't yet
hModule = GetModuleHandle(strLibrary)
If hModule = 0 Then
hModule = LoadLibrary(strLibrary)
If hModule = 0 Then Exit Function
End If
pFunc = GetProcAddress(hModule, "DllGetClassObject")
If pFunc = 0 Then Exit Function
' call DllGetClassObject to get a
' class factory for the class ID
If 0 <> CallPointer(pFunc, _
VarPtr(classid), _
VarPtr(IID_ClassFactory), _
VarPtr(obj)) Then
Exit Function
End If
' IClassFactory VTable
CpyMem vtbl, ByVal obj, 4
CpyMem udtCF, ByVal vtbl, Len(udtCF)
' create an instance of the object
If 0 <> CallPointer(udtCF.CreateInstance, _
obj, _
0, _
VarPtr(IID_IUnknown), _
VarPtr(newobj)) Then
' Set IClassFactory = Nothing
CallPointer udtCF.IUnk.Release, obj
Exit Function
End If
' Set IClassFactory = Nothing
CallPointer udtCF.IUnk.Release, obj
Set CreateObjectFromFile = newobj
End Function
Private Function GetCoClasses( _
ByVal strFile As String, _
udtCoClasses() As CoClass _
) As Boolean
Dim hRes As HRESULT
Dim udtITypeLib As ITypeLib
Dim udtITypeInfo As ITypeInfo
Dim udtTypeAttr As TYPEATTR
Dim oTypeLib As Long
Dim oTypeInfo As Long
Dim pVTbl As Long
Dim pAttr As Long
Dim lngTypeInfos As Long
Dim lngCoCls As Long
Dim strTypeName As String
Dim i As Long
' load the type lib of the file
hRes = LoadTypeLibEx(StrPtr(strFile), REGKIND_NONE, oTypeLib)
If hRes <> S_OK Then Exit Function
' ITypeLib's VTable
CpyMem pVTbl, ByVal oTypeLib, 4
CpyMem udtITypeLib, ByVal pVTbl, Len(udtITypeLib)
lngTypeInfos = CallPointer(udtITypeLib.GetTypeInfoCount, oTypeLib)
For i = 0 To lngTypeInfos - 1
hRes = CallPointer(udtITypeLib.GetTypeInfo, _
oTypeLib, i, _
VarPtr(oTypeInfo))
If hRes <> S_OK Then GoTo NextItem
' ITypeInfo's VTable
CpyMem pVTbl, ByVal oTypeInfo, 4
CpyMem udtITypeInfo, ByVal pVTbl, Len(udtITypeInfo)
' TYPEATTR struct, which describes the type
CallPointer udtITypeInfo.GetTypeAttr, oTypeInfo, VarPtr(pAttr)
CpyMem udtTypeAttr, ByVal pAttr, Len(udtTypeAttr)
CallPointer udtITypeInfo.ReleaseTypeAttr, oTypeInfo, pAttr
' name of the type
CallPointer udtITypeLib.GetDocumentation, _
oTypeLib, i, _
VarPtr(strTypeName), _
0, 0, 0
If udtTypeAttr.TYPEKIND = TKIND_COCLASS Then
ReDim Preserve udtCoClasses(lngCoCls) As CoClass
With udtCoClasses(lngCoCls)
.guid = udtTypeAttr.guid
.Name = strTypeName
End With
lngCoCls = lngCoCls + 1
End If
' Set ITypeInfo = Nothing
CallPointer udtITypeInfo.IUnk.Release, oTypeInfo
oTypeInfo = 0
NextItem:
Next
' Set ITypeLib = Nothing
CallPointer udtITypeLib.IUnk.Release, oTypeLib
'
GetCoClasses = True
End Function
Private Function CallPointer( _
ByVal fnc As Long, _
ParamArray params() _
) As Long
Dim btASM(&HEC00& - 1) As Byte
Dim pASM As Long
Dim i As Integer
pASM = VarPtr(btASM(0))
AddByte pASM, &H58 ' POP EAX
AddByte pASM, &H59 ' POP ECX
AddByte pASM, &H59 ' POP ECX
AddByte pASM, &H59 ' POP ECX
AddByte pASM, &H59 ' POP ECX
AddByte pASM, &H50 ' PUSH EAX
For i = UBound(params) To 0 Step -1
AddPush pASM, CLng(params(i)) ' PUSH dword
Next
AddCall pASM, fnc ' CALL rel addr
AddByte pASM, &HC3 ' RET
CallPointer = CallWindowProc(VarPtr(btASM(0)), _
0, 0, 0, 0)
End Function
Private Sub AddPush(pASM As Long, lng As Long)
AddByte pASM, &H68
AddLong pASM, lng
End Sub
Private Sub AddCall(pASM As Long, addr As Long)
AddByte pASM, &HE8
AddLong pASM, addr - pASM - 4
End Sub
Private Sub AddLong(pASM As Long, lng As Long)
CpyMem ByVal pASM, lng, 4
pASM = pASM + 4
End Sub
Private Sub AddByte(pASM As Long, bt As Byte)
CpyMem ByVal pASM, bt, 1
pASM = pASM + 1
End Sub
' http://www.aboutvb.de/khw/artikel/khwcreateguid.htm
Private Function GUID2Str( _
GUIDBytes() As Byte _
) As String
Dim nTemp As String
Dim nGUID(15) As Byte
Dim nLength As Long
nTemp = Space$(78)
CpyMem nGUID(0), GUIDBytes(0), 16
nLength = StringFromGUID2(nGUID(0), nTemp, Len(nTemp))
GUID2Str = Left$(StrConv(nTemp, vbFromUnicode), nLength - 1)
End Function