FAQ's de VB6

[GeoAvila]

Pregunta:
¿Como conectarme a MySQL desde VB6?

Respuesta:
1ro. Tener instalado un servidor Mysql con el puerto 3306 abierto y tener configurado el usuario correctamente para poder acceder remotamente o bien sea via localhost.

2do. Tener instalado en la computadora Cliente el Mysql ODBC Driver 3.51, que lo pueden descargar de Mysql.com


3ro. bueno.. el codigo..

Código:

        Dim Cxn As ADODB.Connection
        Dim AdoS As ADODB.Recordset
	Dim CxnFac As String
	Set Cxn = New Connection
	Cxn.CursorLocation = adUseClient
	CxnFac = "Driver={MySQL ODBC 3.51 Driver};Server=IpServer;Port=3306;Option=131072;Stmt=;Database=recepfac;Uid=root;Pwd=TuContrasena;"
	Cxn.Open CxnFac ' Abrimos la conexion
	Set AdoS = New Recordset
	AdoS.Open "Select * From clientes", Cxn, adOpenStatic, adLockOptimistic ' Abrimos el REcordset y esta listo para usar
	MsgBox AdoS!nombre

Bueno basta decir que este caso tenemos una tabla llamada clientes que posee un campo llamado nombre..

nos vemos..

[GeoAvila]

pregunta:
¿Como separar una cadena por un caracter determinado?

Respuesta:
con el comando Split
un ejemplo. solo debes de agregar un boton con nombre Command1

Código:

'por Geovanny G. Avila
'geoavila.com
'Por favor no remover esta área por respeto al autor.
Dim Separo() As String
Private Sub Command1_Click()
SepararCadenas "C:\hola|C:\chau", "|"
End Sub
Private sub SepararCadenas(Str As String, Caracter As String)
Dim Sep As Integer
Dim I As Integer ' variable para contar las cadenas
Dim E As Long ' variable para presentar una a una las cadenas
Dim ContStr As Long ' para saber cuantos caracteres tiene la cadena
Dim Separo() As String ' para mostrar almacenar las cadenas en cada array
 
'seamos las cadenas en 0 como número inicial
Sep = 0
'contamos los caracteres
CountStr = Len(Str)
'Contamos cuantas cadenas hay
For E = 1 To CountStr
	Otxt = Mid(Str, E, 1)
	If Otxt = Caracter 'Then ' si es el separador sumar una cadena más
		Sep = Sep + 1
	End If
Next E
'Separmos las cadenas.
Separo = Split(Str, Caracter ) ' El split nos sirve para serparar cadenas en las cuales
						' metemos en nuestro array
 
For I = 0 To Sep ' que cuente cuantas cadenas hay
MsgBox Separo(I) 'que muestre cadena por cadena
Next I
' listo
End Sub

aca de les dejo un ejemplo con archivo leido desde un txt, separado por comas

[aldo1982]

ke diferencia hay entre ADO y DAO ??

las diferencias son las siguientes:
================================================== ==
ADO

ADO(Data Access Object) Objeto de acceso a datos.

(ActiveX Data Objetc) Interface de acceso a datos usado para comunicar OLEDB data souces, como MS SQL Server. Es una Interface a nivel aplicación que usa OLEDB, una libreria de Objetos COM que permite el acceso a diversas fuentes de datos.

ADO a Alto Nivel
ADO No Siempre es flexible, En especial cuando queremos tareas en un solo paso. No obstante, Un Componente de Capa Media puede hacer a ADO realmente simple. Ideas que evolucionan en ADO.NET

--------------------------------------------------------------------------------



El acceso a datos a alto nivel fue una innovación de Visual Basic 3, y quizás fue eso lo que desde 1993 hizo popular este lenguaje: sencillez y eficacia. Todo empezó con los Objetos de Acceso a Datos, DAO, que son unos componentes de software diseñados y optimizados para bases de datos de Microsoft Access. Fue tan buena idea, que DAO pronto fue capacitado para poder desarrollar en entornos Cliente-Servidor (ODBCDirect), aunque no con el desempeño deseado, pero era algo. De aquí que se escribiera algo especializado para entornos Cliente-Servidor, que se denomino RDO, el cual tubo una corta vida debido a los avances tecnológicos detrás del software. Entonces la tecnología de componentes de Microsoft, basada en el modelo COM, necesitaba algo totalmente afín a su naturaleza para acceder a datos, entonces se escribió lo que hoy conocemos como ADO. La universalidad de ADO le da sus meritos. No obstante, ADO no es siempre flexible, en especial cuando queremos tareas en un solo paso. No obstante, un componente de capa media puede hacer a ADO realmente simple. Ideas que evolucionan en ADO.NET.

Clases y Más Clases
Hace ya varios años que Visual Basic dejo de ser un lenguaje simple, y un desarrollador Visual Basic que no sepa escribir clases vera muy sub-utilizada su capacidad. Los componentes de capa media se escriben en clases, y solo en clases. Los objetos que se escriben con Visual Basic son magia, puedes hacer tareas realmente complejas tan solo con hacer referencia a una DLL y usarla.

Simplificando ADO
Yo he simplificado mucho mi escritura de software de acceso a datos al hacer funciones reutilizables que encapsulan operaciones de ADO. Naturalmente estas funciones van a parar en un componente ActiveX que bautice ADOFunctions. Me explico, si escribimos una función como la siguiente:

Public Function StaticRecordset( _
QueryName As String, _
ParamArray Param() As Variant _
) As ADODB.Recordset

Dim rs As ADODB.Recordset
Dim cmd As ADODB.Command
Dim pmt As ADODB.Parameter
Dim i As Long

On Error GoTo ErrHandler

Set cmd = New ADODB.Command
Set rs = New ADODB.Recordset

With cmd
.ActiveConnection = m_ConnectionString
.CommandType = adCmdTable
.CommandText = "[" & QueryName & "]"
For Each pmt In .Parameters
pmt.Value = Param(i)
i = i + 1
Next
End With

With rs
.CursorLocation = adUseClient
.Open cmd, , adOpenStatic
Set cmd.ActiveConnection = Nothing
Set cmd = Nothing
Set .ActiveConnection = Nothing
End With

Set StaticRecordset = rs
Exit Function

ErrHandler:
Set StaticRecordset = Nothing
Call ErrHandlerAction(Err)
End Function




-------------------------------------------------------------
DAO
Definición de tabla: definición
Un objeto DAO de definición de tabla, representado en MFC por un objeto CDaoTableDef, es un objeto que define la estructura de una tabla base o una tabla asociada.

Una tabla base es una tabla de una base de datos de Microsoft Jet (.MDB). Se puede manipular la estructura de una tabla base mediante objetos DAO o instrucciones SQL del Lenguaje de definición de datos (DDL), y se pueden utilizar conjuntos de registros y consultas de acción para modificar los datos de una tabla base.

Una tabla asociada es una tabla de otra base de datos vinculada a una base de datos de Microsoft Jet (.MDB). Los datos de las tablas asociadas permanecen en la base de datos externa, donde pueden ser manipulados por otras aplicaciones. Con las tablas asociadas no se puede usar el conjunto de registros de tipo tabla ni modificar el esquema de las mismas, pero se pueden utilizar conjuntos de registros de tipo dinámico e instantánea.

Usos de la definición de tabla
El principal uso de los objetos de definición de tabla es la manipulación de la estructura de una tabla. Se puede:

Basar un conjunto de registros en una definición de tabla. El conjunto de registros es un conjunto de registros de tipo tabla. Vea CDaoRecordset::Open en la Referencia de MFC.
Examinar la estructura de tablas base locales, tablas asociadas y tablas externas. En la estructura de una tabla se incluyen los campos y los índices.
Agregar o eliminar campos e índices en tablas base locales y tablas externas que se abren directamente en vez de asociarse.
Establecer la información de conexión y el nombre de una tabla asociada y actualizar el vínculo a una tabla asociada.
Determinar si los datos de los campos de una tabla son editables.
Obtener o establecer condiciones de validación de una tabla.
Se pueden utilizar tablas como base para abrir conjuntos de registros de dos formas. Se puede:

Abrir un conjunto de registros basado en un puntero CDaoTableDef.
Crear un conjunto de registros de tipo tabla basado en la tabla.
Para obtener una explicación completa de lo que se puede hacer con las definiciones de tabla, vea el tema "TableDef (Objeto)" en la Ayuda de DAO.

Colecciones DAO y de definiciones de tabla
Cada objeto DAO de base de datos mantiene una colección TableDefs, a saber, una colección de todas las definiciones de tabla guardadas en la base de datos. La colección contiene una definición de tabla por cada tabla de la base de datos. Cada objeto de definición de tabla mantiene dos colecciones propias:

Campos Todos los campos de la definición de tabla, uno por cada campo de la tabla subyacente.
Índices Todos los índices definidos en la tabla.
Los objetos MFC no almacenan una representación de una colección DAO. En su lugar, MFC obtiene acceso a la colección a través del objeto DAO subyacente. Para obtener más información, vea el artículo Colecciones DAO.

MFC tampoco proporciona una clase de C++ para representar cada objeto DAO. En particular, no hay objetos MFC de campo ni de índice. Se trabaja con campos e índices de una definición de tabla a través de funciones miembro de la clase CDaoTableDef.
-------------------------------------------
fuentes:
ADO:http://www.mvps.org/vexpert/articles/adoAltoNivel.htm
DAO: http://msdn.microsoft.com/library/sp...o_tabledef.asp

[lop7]

'Ejemplo de creación de controles en tiempo de ejecución


'Llevará la cuenta de los controles creados

Código:

Option Explicit
Private numControles As Long
Private Sub cmdCrear_Click()
    'Crear un nuevo control de cada tipo'numControles está declarada a nivel de módulo
    numControles = numControles + 1
    'Crear los controles
    Load Label1(numControles)
    Load Text1(numControles)

    'Posicionarlos y hacerlos visibles
    With Label1(numControles)
        .Visible = True
        .Top = Label1(numControles - 1).Top + .Height + 120
        .Caption = "Label1(" & numControles & ")"
    End With
    With Text1(numControles)
        .Visible = True
        .Top = Text1(numControles - 1).Top + .Height + 60
        .Text = "Text1(" & numControles & ")"
    End With
End Sub

'Eliminar un elemento de cada control anteriormente creado'El control

Código:

Private Sub cmdEliminar_Click()
    CERO no se puede eliminar
    If numControles > 0 Then
        'Descargarlos de la memoria
        Unload Label1(numControles)
        Unload Text1(numControles)
        numControles = numControles - 1
    End If
End Sub

espero les sirva
Nos Vemos.....

[GeoAvila]

Pregunta:
¿Como Guardar imagenes y Como Previsualiar imagenes de Una DB?

Respuesta:
Bueno la verda ultimamente he visto que muchos foreros ha estado interesados en este codigo y bueno la le dedique un tiempecito al proyecto y bueno se los dejo a disposición.

Nos vemos..

[aldo1982]

COMO BLOKEAR Y DESBLOKEAR EL REGISTRO DE WINDOWS (PA WINxp) ?

Bloquear y desbloquear el Registro de Windows
Algunas veces puede que sea necesario bloquear el registro de Windows para impedir que otros usuarios accedan a él y puedan modificar configuraciones.
Esta opción es un poco complicada ya que al hacerlo tampoco nos dejará acceder al registro, pero no hay que preocuparse porque primero veremos como hacer para bloquear el registro y luego como haremos para desbloquearlo.
Para deshabilitar el registro de Windows:
Hacemos clic en el botón Inicio y luego en Ejecutar
Escribimos la palabra Regedit y pulsamos el botón Aceptar
Ahora en el registro de Windows buscamos la clave HKEY_CURRENT_USER/ Software Microsoft/ Windows/ CurrentVersion/ Policies/System.
En la ventana de la derecha creamos un nuevo valor DWORD y le damos el nombre DisableRegistryTools
Hacemos doble clic sobre él y le damos el valor "1" para deshabilitar las funciones de edición del registro.
Una vez realizada esta operación ya nadie podrá acceder al registro de Windows, hasta que no lo volvamos a activar
Para habilitar el registro de Windows:
Abrimos el bloc de notas y escribimos lo siguiente:
Windows Registry Editor Version 5.00
[HKEY_CURRENT_USER\Software\Microsoft\Windows\Curre ntVersion\Policies\system] "DisableRegistryTools"=dword:00000000
Ahora guardamos el bloc de Notas con el nombre unlock.reg y a partir de ahora cuando queramos habilitar el registro de Windows, después de haberlo deshabilitado solo tendremos que hacer doble clic sobre el archivo que acabamos de crear unlock.reg.
Así de esta forma mi consejo es que primero crees el archivo unlock.reg y luego deshabilites el registro.

[GeoAvila]

Pregunta:
¿Cómo listar las conexión dial up de nuestro sistema?

Respuesta:
Hace un tiempo hice un aplicación en la cual se enviavan correos pero el usuario tenía que seleccion con que conexión deseaba enviar el correo de mi aplicación, asi que buscando encontre este código.

espero les sirva..

[aldo1982]

COMO INSERTAR UN GIF ANIMADO EN VISUAL BASIC ?

RESPUESTA:

BUENO HAY VARIAS FORMAS DE HACERLO, LA KE YO UTILIZO ES MEDIANTE LA OCX MARCHOSO

PUEDEN DESCARGARSE EL CÓDIGO FUENTE COMPRIMIDO (ZIP) DE:

http://usuarios.lycos.es/damianovich/CODFUENTE.php

SALU2 Y ESPERO LES SIRVA

[Jad-Neo]

Este código sirve para simular una ProgressBar al estilo Windows 95 en un control PictureBox. Espero les guste, ya que sólo con cambiar el ForeColor del PicBox cambian el color de la barra y su texto, también si ponen el Pic en Flat y a Fixed Single toma una apariencia bastante atractiva, cosa que el ProgressBar de los Common Controls no trae:

Código:

Sub SimPGB(pctBox As PictureBox, PercentValue As Single, Optional Caption, Optional Horizontal As Boolean = True)
    Dim strPercent As String
    Dim intX As Integer
    Dim intY As Integer
    Dim intWidth As Integer
    Dim intHeight As Integer
    Dim intPercent As Single
    On Error GoTo ErLg

    If pctBox Is Nothing Then Error 5

    pctBox.AutoRedraw = True
    pctBox.BackColor = vbWhite

    intPercent = Int(100 * PercentValue + 0.5)

    If PercentValue < 0 Or PercentValue > 1# Then Error 5

    If IsMissing(Caption) = True Then
        strPercent = Format$(intPercent) & "%"
        intWidth = pctBox.TextWidth(strPercent)
        intHeight = pctBox.TextHeight(strPercent)
    Else
        intWidth = pctBox.TextWidth(Caption)
        intHeight = pctBox.TextHeight(Caption)
    End If

    intX = pctBox.Width / 2 - intWidth / 2
    intY = pctBox.Height / 2 - intHeight / 2

    pctBox.DrawMode = 13
    pctBox.Line (intX, intY)-(intWidth, intHeight), pctBox.BackColor, BF

    pctBox.CurrentX = intX
    pctBox.CurrentY = intY

    If IsMissing(Caption) = True Then
        pctBox.Print strPercent
    Else
        pctBox.Print Caption
    End If

    pctBox.DrawMode = 10

    If Horizontal = True Then
        If PercentValue > 0 Then
            pctBox.Line (0, 0)-(pctBox.Width * PercentValue, pctBox.Height), pctBox.ForeColor, BF
        Else
            pctBox.Line (0, 0)-(pctBox.Width, pctBox.Height), pctBox.BackColor, BF
        End If
    Else
        If PercentValue > 0 Then
            pctBox.Line (0, pctBox.Height)-(pctBox.Width, pctBox.Height - (pctBox.Height * PercentValue)), pctBox.ForeColor, BF
        Else
            pctBox.Line (0, pctBox.Height)-(pctBox.Width, pctBox.Height), pctBox.BackColor, BF
        End If
    End If
    
Exit Sub
ErLg: Error Err.Number
End Sub

Bye y ojala les guste.

[GeoAvila]

Pregunta:
¿Como listar las Impresoras y Elegir una Determinada?

Respuesta:
bueno usando un modulo que econtre en mpv's, este ejemplo lista las impresoras que estan instaladas en un combo y al seleccionarla permite imprimir en la impresora seleccionada.

Espero les siriva.

Nos vemos..

[GeoAvila]

Pregunta:
¿Como enviar un correo via SMTP?

Repuesta:
yo como muchos otros pasé mucho tiempo buscando una forma de como enviar correos y bueno resulto que probé con el winsock con el cdonts y muchos otros más creanme que me costo de esto ya hace un buen tiempo y he visto que es bastante concurrido este ejemplo asi que decidí compartir con ustedes el ejemplo que me saco de todo apurto con esto es una ocx llamada smtp, coloco un el ejemplo que vení inicialmente con el esta ocx funciona al 100% sin necesidad de configurar nada más la he utilizado en mucho proyectos y puedo dar fé que si funciona. asi que les dejo uno de mis código más atesorados por el tiempo que llevó encontralo. y ahora lo comparto.

[David]

Código:

 
Private Declare Function SetSystemTime Lib "kernel32.dll" (lpSystemTime As SYSTEMTIME) As Long
Public Type SYSTEMTIME 
wYear As Integer
		 wMonth As Integer
		 wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Integer
End Type
Public Function CambiarHora(ByVal Hora As Integer, ByVal Minutos As Integer, Byval Segundos As Integer)
Dim Ahora As SYSTEMTIME 
Ahora.wYear = Year(Date)
Ahora.wMonth = Month(Date)
Ahora.wDay = Day(Date)
Ahora.wHour = Hora
Ahora.wMinute = Minutos
Ahora.wSecond = Segundos
CambiarHora = SetSystemTime(Ahora)
End Function
Public Function CambiarFecha(Byval Año As Integer, Byval Mes As Integer, Byval Dia As Integer)
Dim Hoy As SYSTEMTIME 
Hoy.wYear = Año
Hoy.wMonth = Mes
Hoy.wDay = Dia
Hoy.wHour = Hour(Time)
Hoy.wMinute = Minute(Time)
Hoy.wSecond = Second(Time)
CambiarFecha = SetSystemTime(Hoy)
End Function

[Jad-Neo]

Como cargar un archivo en memoria:

Código:

Funtion LoadFile (ByVal FileName As String, Optional IsText As Boolean) As String
Dim tmpF() As Byte, FLen As Long
Dim Num As Integer, tmpStr As String
On Error Goto ErrLog
FLen=FileLen(FileName)
Num=FreeFile()

Open FileName For Binary Access Read As #Num
If IsText = False Then
     'Para cargar la matriz de bytes
     ReDim tmpF(0 To (FLen-1)) As Byte
     Get #1, ,tmpF
     LoadFile=tmpF
Else
     'Para cargar como cadena de texto
     '(ideal para archivos de texto)
     tmpStr=String(FLen, 0)
     Get #1, ,tmpStr
     LoadFile=tmpStr
End If
Close #Num
'Se libera memoria
Erase tmpF: tmpStr=""

Exit Function
ErrLog:
       Erase tmpF: tmpStr=""
       Error Err.Number
End Function

[GeoAvila]

Pregunta:
¿Como filtar información de Combo a Datalist?

Respuesta:
Bueno conmemorando mi post 2000 coloco este post para el uso de un datacombo que filtra información a un datalist, este datalist tambien puede ser reemplazado por un datacombo también para los que deseamos dos datacombos.

el ejemplo está adjunto

[pcarvajal]

Al tratar de acceder con CR a una BD ACCESS 2000 desplega un error de libreria: ODAPIxx.DLL

La información técnica es la siguiente:
http://support.businessobjects.com/l...s/c2006737.asp

Los drivers a descargar:
http://support.businessobjects.com/c...rivers.zip.asp

Espero la información les sea útil,
Saludos!

[GeoAvila]

pregunta:
¿como cargar un reporte de Cristal Reports?
repuesta por "enea":
bueno enea contribuyo en la busqueda de este código, el cual carga un reporte de crystal reports.

Código:

Dim crystal As CRAXDRT.Application
Dim Report As CRAXDRT.Report

CRViewer.DisplayBorder = False
CRViewer.DisplayTabs = False
CRViewer.EnableDrillDown = False
CRViewer.EnableRefreshButton = False

RS.Open "Select factura.*, detfactura.*, cliente.Empresa, cliente.NIF, cliente.Direccion_Fiscal, cliente.Poblacion_Fiscal, cliente.CP_Fiscal from factura, detfactura, cliente where cliente.Id=factura.Id_Cliente and factura.Id_Factura=detfactura.Id_factura and factura.Id_Factura=" & Id, Cxn, adOpenStatic, adLockReadOnly
Set crystal = New CRAXDRT.Application
Set Report = crystal.OpenReport(App.Path & "\factura.rpt")
Report.DiscardSavedData
Report.Database.SetDataSource RS

CRViewer.ReportSource = Report
CRViewer.ViewReport

Do While CRViewer.IsBusy
DoEvents
Loop

CRViewer.Zoom 100
RS.Close

nos vemos..

[David]

Primeramente especifico, que yo no hice nada para descubrir esto y lo posteo porque es la tercera vez que se toca el tema en este Foro...
El código más bien es descubrimiento del Usuario Beakdan... (Code by Paul Caton)
Les dejo los Links (también por Beakdan) porque el código se me hace largo para postearlo:

Ruedita del Mouse para Form:
http://www.ag-info.com/FormScroll.zip

Ruedita del Mouse para MHFlexGrid:
http://www.ag-info.com/MsGrid_SC.zip

También será bueno si revisan los Posts Originales en las que se ha dado estos códigos:
http://www.forosdelweb.com/showthread.php?t=253337
http://www.forosdelweb.com/f14/habilitar-boton-del-medio-del-mause-mshflexgrid-247531/

Para buscar una mejor comprensión, les explico que el que hizo esto (Paul Caton) lo que hizo fue interceptar los mensajes del Windows para la ventana, y comparar el hWnd con el que se ha registrado.... Bueno, espero les sirva....

[Jad-Neo]

Funciones para poder mostrar el PopUpMenu de los menus de SmartMenuXP, (ojo, los PopUpMenus de SmartMenuXP sólo se muestran si el control esta en Visible = False):

Código:

Function PosX(frm As Form, ByVal X As Single) As Integer
Dim nX As Integer, posX As Integer

nX = X / Screen.TwipsPerPixelX
posX = frm.Left / Screen.TwipsPerPixelX

PosX = (posX + nX) + 3
End Function

Function PosY(frm As Form, ByVal Y As Single) As Integer
Dim nY As Integer, posY As Integer

nY = Y / Screen.TwipsPerPixelY
posY = frm.Top / Screen.TwipsPerPixelY

PosY = (posY + nY) + 22
End Function

Ejemplo:

Código:

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 2 Then SmartMenuXP1.PopupMenu "mnuFile", PosX(Me, X), PosY(Me, Y)
End Sub

[GeoAvila]

¿como detectar dependencias de mi .exe?

respuesta:

bueno para revisar las dependencias de nuestro exe en lo personal he visto este software que es bastante popular para esto.

http://www.dependencywalker.com/

nos vemos..

[GeoAvila]

Prugunta:
¿Como puedo hacer que los controles acoplen al Form?
Repuesta:
El ejemplo reponde a la pregunta de como hacer para que los controles ser redimencionen junto con el form les dejo el ejemplo para que lo prueben..

http://www.geoavila.com/vb60/codigos/1/index.html


y aqui otro código por antonio2005p

Código:

Public ALTURA, ANCHO, DERECHA, IZQUIERDA, BUCLE

Private Sub Form_Load()
BUCLE = 0
ALTURA = Me.Height
ANCHO = Me.Width
End Sub

Private Sub Form_Resize()
If Me.Height > 2000 Then
    Dim OBJECTO As Object
    Dim RESALTURA, RESANCHO
    If BUCLE > 0 Then
        RESALTURA = ((Val(Me.Height) * 100) / ALTURA)
        RESANCHO = ((Val(Me.Width) * 100) / ANCHO)
        For Each OBJECTO In Controls
            OBJECTO.Height = ((Val(OBJECTO.Height) * RESALTURA) / 100)
            OBJECTO.Width = ((Val(OBJECTO.Width) * RESANCHO) / 100)
            OBJECTO.Top = ((Val(OBJECTO.Top) * RESALTURA) / 100)
            OBJECTO.Left = ((Val(OBJECTO.Left) * RESANCHO) / 100)
        Next OBJECTO
    End If
    BUCLE = BUCLE + 1
    ALTURA = Me.Height
    ANCHO = Me.Width
End If
End Sub
 

nos vemos...

[leoj90]

Pregunta:
No se nada de programación... ¿Cómo empiezo?
Respuesta:
Estudia la metodología de la programación con pseudocódigos desde aquí:
http://canalvisualbasic.net/metodologia/metodologia.asp

Pregunta:
¿Cómo puedo empezar con Visual Basic?
Respuesta:
Con este manual, que es para uno que no sabe absolutamente nada de visual basic: http://4shared.com/file/314268/3c9cf...l_Basic_6.html

Importante: Este manual (el de aqui arriba) tiene muchos errores, así que solamente lo recomiendo para el que no sepa absolutamente nada de visual basic. Léanlo y aprendan los fundamentos, porque en los ejemplos hay muchos errores.


Pregunta:
Bien, ya lo lei, ¿dónde consigo uno más avanzado?
Respuesta:
En la página web de GeoAvila tienes unos cuantos: http://geoavila.com

[VisualGuallabo]

Siempre me ha gustado no depender de ocx. Ya que las mismas deben ser registradas y encontrarse en la pc que se ejecute la aplicación. Y he dedicado parte de mi tiempo en busca de códigos que me quiten de encima las famosas ocx que tanto usamos en nuestros programas. Y en la búsqueda encontré este código para reproducir un gif.

Controles.
----------------------------------
1- Image con la propiedad name=AnimatedGIF y con Index=0
2-CommandButton con la propiedad name=btnPlay
3-Timer con la propiedad name=AnimationTimer
4-TextBox con la propiedad name=txFile



Copiar este codigo:
---------------------------

Dim RepeatTimes&
Dim RepeatCount&


Private Sub btnPlay_Click()

Call LoadAniGif(txFile.Text, AnimatedGIF)

End Sub


Sub LoadAniGif(xFile As String, xImgArray)

If Not IIf(Dir$(xFile) = "", False, True) Or xFile = "" Then
MsgBox "File not found.", vbExclamation, "File Error"
Exit Sub
End If

Dim F1, F2
Dim AnimatedGIFs() As String
Dim imgHeader As String
Static buf$, picbuf$
Dim fileHeader As String
Dim imgCount
Dim i&, j&, xOff&, yOff&, TimeWait&
Dim GifEnd
GifEnd = Chr(0) & "!ù"

AnimationTimer.Enabled = False
For i = 1 To xImgArray.Count - 1
Unload xImgArray(i)
Next i

F1 = FreeFile
On Error GoTo badFile:
Open xFile For Binary Access Read As F1
buf = String(LOF(F1), Chr(0))
Get #F1, , buf
Close F1

i = 1
imgCount = 0

j = (InStr(1, buf, GifEnd) + Len(GifEnd)) - 2
fileHeader = Left(buf, j)
i = j + 2

RepeatTimes& = Asc(Mid(fileHeader, 126, 1)) + (Asc(Mid(fileHeader, 127, 1)) * 256)

Do
imgCount = imgCount + 1
j = InStr(i, buf, GifEnd) + Len(GifEnd)
If j > Len(GifEnd) Then
F2 = FreeFile
Open "tmp.gif" For Binary As F2
picbuf = String(Len(fileHeader) + j - i, Chr(0))
picbuf = fileHeader & Mid(buf, i - 1, j - i)
Put #F2, 1, picbuf
imgHeader = Left(Mid(buf, i - 1, j - i), 16)
Close F2

TimeWait = ((Asc(Mid(imgHeader, 4, 1))) + (Asc(Mid(imgHeader, 5, 1)) * 256)) * 10
If imgCount > 1 Then
xOff = Asc(Mid(imgHeader, 9, 1)) + (Asc(Mid(imgHeader, 10, 1)) * 256)
yOff = Asc(Mid(imgHeader, 11, 1)) + (Asc(Mid(imgHeader, 12, 1)) * 2561)
Load xImgArray(imgCount - 1)
xImgArray(imgCount - 1).ZOrder 0
xImgArray(imgCount - 1).Left = xImgArray(0).Left + (xOff * 15)
xImgArray(imgCount - 1).Top = xImgArray(0).Top + (yOff * 15)
End If
xImgArray(imgCount - 1).Tag = TimeWait
xImgArray(imgCount - 1).Picture = LoadPicture("tmp.gif")
Kill ("tmp.gif")

i = j '+ 1
End If
Loop Until j = Len(GifEnd)

If i < Len(buf) Then
F2 = FreeFile
Open "tmp.gif" For Binary As F2
picbuf = String(Len(fileHeader) + Len(buf) - i, Chr(0))
picbuf = fileHeader & Mid(buf, i - 1, Len(buf) - i)
Put #F2, 1, picbuf
imgHeader = Left(Mid(buf, i - 1, Len(buf) - i), 16)
Close F2

TimeWait = ((Asc(Mid(imgHeader, 4, 1))) + (Asc(Mid(imgHeader, 5, 1)) * 256)) * 10
If imgCount > 1 Then
xOff = Asc(Mid(imgHeader, 9, 1)) + (Asc(Mid(imgHeader, 10, 1)) * 256)
yOff = Asc(Mid(imgHeader, 11, 1)) + (Asc(Mid(imgHeader, 12, 1)) * 2561)
Load xImgArray(imgCount - 1)
xImgArray(imgCount - 1).ZOrder 0
xImgArray(imgCount - 1).Left = xImgArray(0).Left + (xOff * 15)
xImgArray(imgCount - 1).Top = xImgArray(0).Top + (yOff * 15)
End If
xImgArray(imgCount - 1).Tag = TimeWait
xImgArray(imgCount - 1).Picture = LoadPicture("tmp.gif")
Kill ("tmp.gif")
End If

On Error GoTo badTime
AnimationTimer.Interval = CInt(xImgArray(0).Tag)
badTime:
AnimationTimer.Enabled = True
Exit Sub
badFile:
MsgBox "File not found.", vbExclamation, "File Error"

End Sub

Private Sub AnimationTimer_Timer()

For i = 0 To AnimatedGIF.Count
If i = AnimatedGIF.Count Then
If RepeatTimes > 0 Then
RepeatCount = RepeatCount + 1
If RepeatCount > RepeatTimes Then
AnimationTimer.Enabled = False
Exit Sub
End If
End If
For j = 1 To AnimatedGIF.Count - 1
AnimatedGIF(j).Visible = False
Next j
On Error GoTo badTime
AnimationTimer.Interval = CLng(AnimatedGIF(0).Tag)
badTime:
Exit For
End If
If AnimatedGIF(i).Visible = False Then
AnimationTimer.Interval = CLng(AnimatedGIF(i).Tag)
On Error GoTo badTime2
AnimatedGIF(i).Visible = True
badTime2:
Exit For
End If
Next i

End Sub

Private Sub Form_Load()
Call LoadAniGif(txFile.Text, AnimatedGIF)
End Sub

[GeoAvila]

Tiene Visual Basic 6 soporte para la plataforma x64?

Respuesta:
bueno recientemente con esto de la tecnología x64 que la he colocado en la computadora de mi casa, el visual basic 6 da un mensaje en la instalación en el cual indica que no tiene soporte para la tecnologia x64 asi que para los que deseen programar en visual basic 6 no deben instalar Windows x64 porque no funcionará.


Nos vemos..

[GeoAvila]

Pregunta:
Como bloquear el botton de cerrar de un formulario?

Respuesta:
ok bueno aqui va la respuesta..

coloca esto en tu form

Código:

Private Sub Form_Load()
Bloquear_Cerrar
End Sub
Private Sub Bloquear_Cerrar()
Dim hMenu As Long
    '
hMenu = GetSystemMenu(hWnd, 0)
    ' Deshabilitar el menú cerrar del formulario
Call ModifyMenu(hMenu, SC_CLOSE, MF_BYCOMMAND Or MF_GRAYED, -10, "Close")
End Sub

y en un modulo esto..

Código:

Public Declare Function GetSystemMenu Lib "user32" _
    (ByVal hWnd As Long, ByVal bRevert As Long) As Long
Public Declare Function ModifyMenu Lib "user32" Alias "ModifyMenuA" _
    (ByVal hMenu As Long, ByVal nPosition As Long, _
    ByVal wFlags As Long, ByVal wIDNewItem As Long, _
    ByVal lpString As Any) As Long
Public Declare Function DrawMenuBar Lib "user32" _
    (ByVal hWnd As Long) As Long
'
Public Const MF_BYCOMMAND = &H0&
Public Const MF_ENABLED = &H0&
Public Const MF_GRAYED = &H1&
'
Public Const SC_CLOSE = &HF060&

nos vemos y espero les sirva el codigo...

[Mapachita2807]

Iniciado por hmtech

Pregunta:

Como verificar si un fichero existe?

Resuesta:

Public Sub VerificarFichero(sNombreFichero As String)
On Error Resume Next
Open sNombreFichero For Input As #1
If Err Then
MsgBox ("El fichero " & sNombreFichero & " no existe.")
Exit Sub
End If
Close #1
End Sub


en un botton:

VerificarFichero "c:\prueba.txt"


Version corregida por David el Grande y GeoAvila:

Código:

Dim Archivo As String
Archivo = "C:\MiTexto.txt"
If Dir(Archivo, vbArchive) = "" Then
MsgBox "El Fichero No Existe"
End If

Modificado por RootK

ok, eso es si tienes la ruta del fichero (archivo), pero y si no la tienes, entonces... ¿cómo le haces?

[VisualGuallabo]

Modulo de Clase:
---------------------------------------------------------
Option Explicit
Private Const MAX_PATH& = 260
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetWindowThreadProcessId& Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long)
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Private Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long
Private Declare Function RegisterServiceProcess Lib "kernel32" (ByVal ProcessID As Long, ByVal ServiceFlags As Long) As Long
Private Declare Function TerminateProcess Lib "kernel32" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long

Private Type PROCESSENTRY32
dwSize As Long
cntUsage As Long
th32ProcessID As Long
th32DefaultHeapID As Long
th32ModuleID As Long
cntThreads As Long
th32ParentProcessID As Long
pcPriClassBase As Long
dwFlags As Long
szexeFile As String * MAX_PATH
End Type
Public Sub KillProcess(ByVal ProcessID As Long)
Dim hp&
hp& = OpenProcess(1&, -1&, ProcessID)
TerminateProcess hp&, 0&
DoEvents
End Sub

Public Function FindWindowByClass(ByVal WindowClassName As String) As Long
FindWindowByClass = FindWindow(WindowClassName, vbNullString)
End Function

Public Function FindProcessByWindowClass(ByVal WindowClassName As String) As Long
Dim pid&
GetWindowThreadProcessId FindWindowByClass(WindowClassName), pid&
FindProcessByWindowClass = pid&
End Function

Public Function FindProcessByName(ByVal AppPath As String) As Long
Dim AppPaths, ProcessIds, ParentProcessIds, i As Integer
ListRunningApps AppPaths, ProcessIds, ParentProcessIds
i = FindInArray(AppPaths, AppPath)
If i = -1 Then
FindProcessByName = 0
Else
FindProcessByName = ProcessIds(i)
End If
End Function

Public Sub ListRunningApps(ByRef AppPaths, ByRef ProcessIds, ByRef ParentProcessIds)
Dim uProcess As PROCESSENTRY32
Dim rProcessFound As Long
Dim hSnapshot As Long
Dim szExename As String
Dim i As Integer
Const TH32CS_SNAPPROCESS As Long = 2&

AppPaths = Array()
ProcessIds = Array()
ParentProcessIds = Array()

uProcess.dwSize = Len(uProcess)
hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
rProcessFound = ProcessFirst(hSnapshot, uProcess)

Do While rProcessFound
i = InStr(1, uProcess.szexeFile, Chr(0))
szExename = LCase$(Left$(uProcess.szexeFile, i - 1))
AppendToArray AppPaths, szExename
AppendToArray ProcessIds, uProcess.th32ProcessID
AppendToArray ParentProcessIds, uProcess.th32ParentProcessID
rProcessFound = ProcessNext(hSnapshot, uProcess)
Loop
End Sub
Public Function FindInArray(List As Variant, Item As Variant) As Integer
Dim i As Integer
For i = 0 To UBound(List)
If UCase("" & List(i)) = UCase("" & Item) Then
FindInArray = i
Exit Function
End If
Next
FindInArray = -1
End Function
Private Sub AppendToArray(List As Variant, Item As Variant)
ReDim Preserve List(UBound(List) + 1)
List(UBound(List)) = Item
End Sub

-------------------
y el formulario :
-----------------------
Option Explicit
Private NombreProceso, IdentificacionProceso, ParentIdentificacionProceso
Private PM As Class1, i As Integer

Private Sub Command1_Click()
Set PM = New Class1
PM.ListRunningApps NombreProceso, IdentificacionProceso, ParentIdentificacionProceso
For i = 0 To UBound(NombreProceso)
If NombreProceso(i) = "winamp.exe" Then
PM.KillProcess IdentificacionProceso(i)
DoEvents
End If
Next
End Sub


*El nombre del proceso es el que muestra el programa en lo sprocesos de Windows.

[RootK]

Como crear un chat ? (Proyecto usando winsocks)

http://www.forosdelweb.com/f69/donacion-proyecto-chat-bien-coqueto-364265/

[GeoAvila]

Como subir una imagen via FTP?

http://www.forosdelweb.com/f69/ejemplo-como-subir-imagen-servidor-ftp-365551/

[X.Cyclop]

Pregunta: Dónde consigo OCX para mis aplicaciones?
Respuesta: http://www.softonic.com/seccion/494/ActiveX

[VisualGuallabo]

Option Explicit

Private Declare Function NetMessageBufferSend Lib "netapi32.dll" _
(ByVal servername As String, _
ByVal msgname As String, _
ByVal fromname As String, _
ByVal Buffer As String, _
ByVal BufSize As Long) As Long

Private Const NERR_SUCCESS As Long = 0
Private Const NERR_BASE As Long = 2100
Private Const NERR_NetworkError As Long = (NERR_BASE + 36)
Private Const NERR_NameNotFound As Long = (NERR_BASE + 173)
Private Const NERR_UseNotFound As Long = (NERR_BASE + 150)
Private Const ERROR_ACCESS_DENIED As Long = 5
Private Const ERROR_BAD_NETPATH As Long = 53
Private Const ERROR_NOT_SUPPORTED As Long = 50
Private Const ERROR_INVALID_PARAMETER As Long = 87
Private Const ERROR_INVALID_NAME As Long = 123


Public Function NetSendMessage(ByVal sSendTo As String, ByVal sMessage As String) As Long
Dim ret As Long

'convert ANSI strings to UNICODE
sSendTo = StrConv(sSendTo, vbUnicode)
sMessage = StrConv(sMessage, vbUnicode)
'Send a network message to a remote computer
NetSendMessage = NetMessageBufferSend(vbNullString, sSendTo, vbNullString, _
sMessage, Len(sMessage))
End Function

'returns the description of the Netapi Error Code
Public Function NetSendErrorMessage(ErrNum As Long) As String
Select Case ErrNum
Case NERR_SUCCESS
NetSendErrorMessage = "The message was successfully sent"
Case NERR_NameNotFound
NetSendErrorMessage = "Send To not found"
Case NERR_NetworkError
NetSendErrorMessage = "General network error occurred"
Case NERR_UseNotFound
NetSendErrorMessage = "Network connection not found"
Case ERROR_ACCESS_DENIED
NetSendErrorMessage = "Access to computer denied"
Case ERROR_BAD_NETPATH
NetSendErrorMessage = "Sent From server name not found."
Case ERROR_INVALID_PARAMETER
NetSendErrorMessage = "Invalid parameter(s) specified."
Case ERROR_NOT_SUPPORTED
NetSendErrorMessage = "Network request not supported."
Case ERROR_INVALID_NAME
NetSendErrorMessage = "Illegal character or malformed name."
Case Else
NetSendErrorMessage = "Unknown error executing command."
End Select
End Function


Private Sub Command2_Click()
Dim ret As Long

'send a message to "andrea" user in your network, replace "andrea" with the name
'of the user or the computer you want to send the message to

'in order to receive and send messages in both computers (sender and receiver) you
'must start the messenger service
ret = NetSendMessage("ycc", "this is a message from a VB application")
If ret <> 0 Then
MsgBox NetSendErrorMessage(ret), vbCritical, "Error"
Else
MsgBox NetSendErrorMessage(ret), vbInformation, "NetSend"
End If
End Sub