Leer
un archivo binario
ifile = FreeFile
Open "PathName(e.g.,c:\..\..\..txt)" For Input As #ifile
Line Input #ifile, scurrent
Dim temp
Dim temp2
Dim temp3
Dim temp4
temp = Len(scurrent)
For x = 1 To 10
temp2 = Mid(scurrent, 1, x)
Print Right(temp2, 1)
temp3 = Right(temp2, 1)
Next x
Close #ifile
Num/Scroll/caption
Lock
private Declare Function GetKeyState%
Lib "User" (ByVal nVirtKey%)
private Const VK_CAPITAL = &H14
private Const VK_NUMLOCK = &H90
private Const VK_SCROLL = &H91
form_load()
Capslock% = GetKeyState%(VK_CAPITAL)
Numlock% = GetKeyState%(VK_NUMLOCK)
Scrolllock% = GetKeyState%(VK_SCROLL)
If Capslock% And 1 Then 'Caps IS ON
If Numlock% And 1 Then 'NUMLock is ON
If Scrolllock% And 1 Then 'Scroll is ON
Mensaje
en Winpopup
Private Declare Function CloseHandle
Lib "kernel32" (ByVal hHandle As Long) As Long
Private Declare Function WriteFile
Lib "kernel32" (ByVal hFileName As Long, ByVal lpBuff As Any, ByVal
nNrBytesToWrite As Long, lpNrOfBytesWritten As Long, ByVal lpOverlapped As Long)
As Long
Private Declare Function CreateFile Lib "kernel32"
Alias "CreateFileA" ( ByVal lpFileName As String, ByVal dwAccess As
Long, ByVal dwShare As Long, ByVal lpSecurityAttrib As Long, ByVal
dwCreationDisp As Long, ByVal dwAttributes As Long, ByVal hTemplateFile As Long)
As Long
Private Const OPEN_EXISTING = 3
Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const GENERIC_EXECUTE = &H20000000
Private Const GENERIC_ALL = &H10000000
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_SHARE_READ = &H1
Private Const FILE_SHARE_WRITE = &H2
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Function SendToWinPopUp(PopFrom As String, PopTo As String,
MsgText As String) As Long
' parms: PopFrom: user or computer that sends the message
' PopTo: computer that receives the message
' MsgText: the text of the message to send
Dim rc As Long
Dim mshandle As Long
Dim msgtxt As String
Dim byteswritten As Long
Dim mailslotname As String
' name of the mailslot
mailslotname = "\\" + PopTo +
"\mailslot\messngr"
msgtxt = PopFrom + Chr(0) + PopTo + Chr(0) + MsgText + Chr(0)
mshandle = CreateFile(mailslotname, GENERIC_WRITE,
FILE_SHARE_READ, 0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0)
rc = WriteFile(mshandle, msgtxt, Len(msgtxt), byteswritten, 0)
rc = CloseHandle(mshandle)
End Function
Cambiar
resolucion del monitor
Private Declare Function
EnumDisplaySettings Lib "user32" Alias
"EnumDisplaySettingsA" (ByVal lpszDeviceName As Long, ByVal iModeNum
As Long, lpDevMode As Any) As Boolean
Private Declare Function ChangeDisplaySettings Lib "user32" Alias
"ChangeDisplaySettingsA" (lpDevMode As Any, ByVal dwflags As Long) As
Long
Const CCDEVICENAME = 32
Const CCFORMNAME = 32
Const DM_PELSWIDTH = &H80000
Const DM_PELSHEIGHT = &H100000
Private Type DEVMODE
dmDeviceName As String * CCDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCFORMNAME '20
dmUnusedPadding As Integer
dmBitsPerPel As Integer
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type
Dim DevM As DEVMODE
Private Sub Form_Load()
Dim a As Boolean
a = CambiaResolucion(4, 800, 600)
End Sub
Function CambiaResolucion(BitPorPixel As Integer, Ancho As Long, Alto As Long)
As Boolean
Dim a&
a = EnumDisplaySettings(0&, 0&, DevM)
DevM.dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
DevM.dmBitsPerPel = BitPorPixel
DevM.dmPelsWidth = Ancho
DevM.dmPelsHeight = Alto
a = ChangeDisplaySettings(DevM, 0)
If a = 0 Then
CambiaResolucion = True
Else
CambiaResolucion = False
End If
End Function
RDS
'Oye he estado revisando la
conexion via RDS, y es interesante como desde mi casa pude mostrar y actualizar
informacion via internet. Mira te envio el codigo para que veas lo facil que es.
Dim ads As New DataSpace
Dim adf As Object, rs As Object
Dim strCnRemoto As String, strSqlRemoto As String
' Inicializo las cadenas de acceso a Base de Datos
strSqlRemoto = "Select * From Test"
strCnRemoto = "DSN=dsnTest;UID=sa;PWD=;"
rst.Open strSqlLocal, strCnLocal
Do While Not rst.EOF
lstLocal.AddItem rst(0)
rst.MoveNext
Loop
rst.Close
Set adf =
ads.CreateObject("AdvancedDataFactory","http://www.test.com.pe")
Set rs = adf.query(strCnRemoto, strSqlRemoto)
Do While Not rs.EOF
lstRemoto.AddItem rs(0)
rs.MoveNext
Loop
rs.Close
Formato
ASCII & Formato Windows
Para 16 bits :
Declare Function OemToAnsiBuff Lib
"Keyboard" (ByVal lpOemStr As String,ByVal lpAnsiStr As String, ByVal
nLength As Integer)
Para 32 bits :
Declare Function OemToCharBuff Lib
"user32" Alias "OemToCharBuffA" (ByVal lpszSrc
As String, ByVal lpszDst As String, ByVal cchDstLength As Long) As Long
DBF
Dim DbMdb AS DataBase
Dim NewRs AS RecordSet
' El opendatabase lo que hace es abrir el DIRECTORIO donde se
hallen las bases de datos DBF.
Set dbMDB = OpenDatabase("", True, False, "dBASE
III;database=c:\MiDir\MisDbfs")
Set NewRs =
DbMDB.OpenRecordSet("SELECT * FROM Cli ORDER BY Cli_Cod")
Invocar sentencia SQL
con una comilla interna
Public Function SQuote(ToConvert As
String)
Dim i As Integer
Dim EndString As String
Dim CChar As String
If InStr(1, ToConvert, "'") > 0 Then
For i = 1 To Len(ToConvert)
CChar = Mid(ToConvert, i, 1)
If CChar = "'" Then
CChar = "''"
End If
EndString = EndString & CChar
Next
SQuote = EndString
Else
SQuote = ToConvert
End If
End Function
So you would have the following line:
strSQL = strSQL & "where LName = '" &
SQuote(strLName) & "'"
Cambiar
la ubicacion del mouse con codigo
Private Declare Function
SetCursorPos& Lib "user32" (ByVal x As Long, ByVal y
As Long)
Private Declare Function
ClipCursor& Lib "user32" (lpRect As RECT)
Pasar
con Enter entre controles (No tab)
Private Sub Form_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
KeyAscii = 0
SendKeys "{TAB}"
End If