Mensajes

[igualmente los valores sobre si es visible o no o el color de el progress bar pueden hacerlos variar uds. eso no afecta a la efectividad de la aplicacion]

Código [Seleccionar] Expandir

pb1 min=0 max=100
pb2 min=0 max=100

igualmente los valores sobre si es visible o no o el color de el progress bar pueden hacerlos variar uds. eso no afecta a la efectividad de la aplicacion

[Salu25]

Código [Seleccionar] Expandir

timer1.interval=1000 'debe ir por defecto declarado en el codigo o en el objeto
test2.text="1000"(pueden modificarse con la aplicacion ejecutada)
text3.text="80"(pueden modificarse con la aplicacion ejecutada)

el text1 sera la reta del archivo sobre el cual se va a trabajar.
el text2 la cantidad de bytes a sumar.
el text3 simplemente la cantidad de segundos q deseas q la aplicacion desaparezca.
Command1 es el boton delexplorador de archivos (para elegir el nuestro)
command2 es el q da la orden de sumar los bytes.
Command3 es el q hace desaparecer el form por la cantidad de segundos indicados.


            Salu25

voy a asumir qpor el codigo se imaginan los controles a usar..... saludos

Código [Seleccionar] Expandir

Private Sub Command1_Click()
CD1.ShowOpen
Text1.Text = CD1.FileName
End Sub

Private Sub Command2_Click()
If Text1.Text <> "" And Text2.Text > 0 Then
fsiz = ShowFileSize(Text1.Text)
PB1.Value = 0
PB1.Max = Text2.Text
PB1.Visible = True
Open Text1.Text For Binary As #1
For a = 1 To Text2.Text
Put #1, fsiz - 1 + a, 0
PB1.Value = a
Next
Close
End If
PB1.Visible = False
PB1.Value = 0
End Sub
Function ShowFileSize(file)
    Dim fs, f, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(file)
    ShowFileSize = f.Size
    's = UCase(f.Name) & " uses " & f.Size & " bytes."
    'MsgBox s, 0, "Folder Size Info"
End Function
'94208

Private Sub Command3_Click()
Timer1.Enabled = True
End Sub

Private Sub Form_Load()
Text1.Text = App.Path & "\"
End Sub

Private Sub Text3_Change()
pb2.Max = Text3.Text
End Sub

Private Sub Timer1_Timer()
Form1.Hide
pb2.Value = pb2.Value + 1
If pb2.Value = Text3.Text Then
Form1.Show
pb2.Value = 0
Timer1.Enabled = False
End If
End Sub


muy bueno LeandroA esta ves te pasaste jejejej

Lo posteo aquie por q pense q era donde mejor se veria aceptado.(por favor no lo borren)



este es un pequeño codigo para sumarle bytes a tus exe.

DESCARGA:este link es de la aplicacion,pruebenla si les interesa posteamos el code para poder mejorarlo.

http://www.uploadfilego.com/download.php?file=29cfe51ed29a221787063e8c8c947c0f

es asi a veces lo simple resulta mas util q lo complejo...

o....echa un vistaso a esto, esta en frances pero se entiende

Código [Seleccionar] Expandir

Option Explicit

Private Type tConnect
    lgRequestID As Long
    stPseudo As String
End Type

' Tableau des connexions courantes
Private tabConnect() As tConnect
' Taille du tableau
Private lgConnect As Long

' Pseudo de l'utilisateur courant
Private stPseudo As String

' Port de connexion au serveur
Private Const WSK_PORT = 6667

Private Sub cmdConnect_Click()
' Démarre une connexion au serveur, ou lance un serveur.
' Ferme une connexion, ou arrête le serveur
' En fonction de l'état du bouton...
Dim lgTmp As Long
cmdConnect.Enabled = False
If cmdConnect.Caption = "&Démarrer" Then
    fraConnexion.Enabled = False
    If optConnect(0).Value Then
' Démarre un serveur
        wskIRC(0).LocalPort = WSK_PORT
        wskIRC(0).Listen
        stPseudo = "Serveur"
    Else
' Démarre une connexion cliente
        On Error GoTo ErrConnectClient
        lgTmp = wskIRC(0).LocalPort
ResConnectClient:
        If wskIRC(0).State <> sckClosed Then wskIRC(0).Close
        wskIRC(0).LocalPort = lgTmp
        wskIRC(0).Connect txtServeur.Text, WSK_PORT
    End If
    cmdConnect.Caption = "A&rreter"
    txtMot.Enabled = True
    txtMot.SetFocus
Else
    If optConnect(0).Value Then
' Arrête le serveur courant
        wskIRC(0).Close
        For lgTmp = 1 To lgConnect
            If (tabConnect(lgTmp).lgRequestID > 0) Then
                wskIRC(lgTmp).Close
                Unload wskIRC(lgTmp)
                DoEvents
            End If
        Next lgTmp
        lgConnect = 0
    Else
' Arrête la connexion cliente courante
        wskIRC(0).Close
    End If
    stPseudo = vbNullString
    fraConnexion.Enabled = True
    cmdConnect.Caption = "&Démarrer"
    txtMot.Enabled = False
End If
cmdConnect.Enabled = True
Exit Sub
' Gestion d'erreur, pour permettre des tests en local
ErrConnectClient:
If Err.Number = 40020 Or Err.Number = 10048 Then
    lgTmp = lgTmp - 1
    Resume ResConnectClient
End If
End Sub
Private Sub cmdQuitter_Click()
' Quitte l'application
Unload Me
End Sub
Private Sub Form_Load()
' Initialisation des zones
lblIP.Caption = "Adresse IP : " & wskIRC(0).LocalIP
rtbForum.Text = vbNullString
txtMot.Text = vbNullString
' Initialisation des variables
lgConnect = 0
End Sub

Private Sub optConnect_Click(Index As Integer)
If Index = 1 Then txtServeur.SetFocus
End Sub

Private Sub txtMot_KeyPress(KeyAscii As Integer)
' Gestion des phrases à afficher
Dim lgFor As Long
Dim stEnvoi As String
If KeyAscii = vbKeyReturn Then
    If Left$(txtMot.Text, 1) = "/" Then
' Envoi d'un mot clé
        stEnvoi = txtMot.Text & vbCrLf
    Else
' Envoi d'un message standard
        stEnvoi = "[" & stPseudo & "] " & txtMot.Text & vbCrLf
' Affichage du message
        rtbWrite stEnvoi
    End If
    If optConnect(0).Value Then
' Cas SERVEUR - pour tous les clients
        Call Distribution(stEnvoi)
    Else
' Cas CLIENT - pour le serveur
        wskIRC(0).SendData stEnvoi
    End If
    txtMot.Text = vbNullString
End If
End Sub

Private Sub txtServeur_Click()
optConnect(1).Value = True
End Sub

Private Sub txtServeur_GotFocus()
' Sélection de l'ensemble du texte
txtServeur.SelStart = 0
txtServeur.SelLength = Len(txtServeur.Text)
End Sub

Private Sub rtbWrite(stTexte As String, Optional blGras As Boolean = False, Optional blItalique As Boolean = False, Optional blSouligne As Boolean = False, Optional vColor As OLE_COLOR = vbBlack)
' Ecrit un texte dans le contrôle RichTextBox avec les options souhaitées
rtbForum.SelStart = Len(rtbForum.Text)
rtbForum.SelText = rtbForum.SelText & stTexte
rtbForum.SelStart = Len(rtbForum.Text) - Len(stTexte)
rtbForum.SelLength = Len(stTexte)
rtbForum.SelBold = blGras
rtbForum.SelItalic = blItalique
rtbForum.SelUnderline = blSouligne
rtbForum.SelColor = vColor
rtbForum.SelStart = Len(rtbForum)
End Sub
Private Sub wskIRC_Close(Index As Integer)
' Fermeture d'une connexion
Dim lgFor As Long
Dim stEnvoi As String
wskIRC(Index).Close
If optConnect(0).Value Then
' Cas SERVEUR - Déconnexion + avertissement pour départ du participant
    stEnvoi = tabConnect(Index).stPseudo & " a quitté VBIRC." & vbCrLf
    rtbWrite stEnvoi
    tabConnect(Index).lgRequestID = -1
    tabConnect(Index).stPseudo = vbNullString
    Call Distribution(stEnvoi)
Else
' Cas CLIENT
    rtbWrite "Le serveur a fermé la connexion..." & vbCrLf, True, , , vbRed
    fraConnexion.Enabled = True
    cmdConnect.Caption = "&Démarrer"
    txtMot.Enabled = False
    wskIRC(0).Close
End If
End Sub
Private Sub wskIRC_Connect(Index As Integer)
rtbWrite "Connexion sur " & txtServeur.Text & " acceptée..." & vbCrLf, True, , , vbRed
End Sub
Private Sub wskIRC_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Dim lgFor As Long
Dim stEnvoi As String
' Recherche du premier indice de connexion disponible
For lgFor = 1 To lgConnect
    If tabConnect(lgFor).lgRequestID < 0 Then Exit For
Next lgFor
If lgFor > lgConnect Then
' Augmente le tableau des connexions
    ReDim Preserve tabConnect(lgFor) As tConnect
' Création d'un nouveau WinSock de dialogue
    Load wskIRC(lgFor)
    lgConnect = lgFor
End If
' Enregistrement du requestId
tabConnect(lgFor).lgRequestID = requestID
' Accepte la connexion
wskIRC(lgFor).Accept requestID
tabConnect(lgFor).stPseudo = Pseudo
wskIRC(lgFor).SendData "/PSEUDO " & tabConnect(lgFor).stPseudo & vbCrLf
' Avertissement pour l'arrivée d'un participant
stEnvoi = tabConnect(lgFor).stPseudo & " arrive sur VBIRC." & vbCrLf
rtbWrite stEnvoi
Call Distribution(stEnvoi, lgFor)
End Sub
Private Sub wskIRC_DataArrival(Index As Integer, ByVal bytesTotal As Long)
' Réception de données
Dim stTmp As String, stEnvoi As String
Dim lgFor As Long
Dim tabTmp, tabLst
' Récupère les données
wskIRC(Index).GetData stTmp, vbString
If optConnect(0).Value Then
' Cas SERVEUR - on redistribue à tous les autres clients (sauf à l'expéditeur)
' Réception d'un commande
    tabLst = Split(stTmp, vbCrLf)
    For lgFor = 0 To UBound(tabLst) - 1
        tabTmp = Split(tabLst(lgFor), " ")
        Select Case UCase$(tabTmp(0))
            Case "/PSEUDO"
                stEnvoi = tabTmp(1)
                If PseudoExiste(stEnvoi) Then
                    wskIRC(Index).SendData "Ce pseudo est déjà utilisé..." & vbCrLf
                Else
                    stEnvoi = tabConnect(Index).stPseudo & " s'appelle maintenant " & tabTmp(1) & vbCrLf
                    tabConnect(Index).stPseudo = tabTmp(1)
                    rtbWrite stEnvoi
                    wskIRC(Index).SendData "/PSEUDO " & tabTmp(1) & vbCrLf
                    DoEvents
                    Call Distribution(stEnvoi, CLng(Index))
                End If
            Case Else
    ' Réception d'un texte quelconque
                stEnvoi = tabLst(lgFor) & vbCrLf
                rtbWrite stEnvoi
                Call Distribution(stEnvoi, CLng(Index))
        End Select
    Next lgFor
Else
' Cas CLIENT
' Réception d'une commande serveur
    tabLst = Split(stTmp, vbCrLf)
' Décompose le texte reçu en lignes de texte
    For lgFor = 0 To UBound(tabLst) - 1
        tabTmp = Split(tabLst(lgFor), " ")
        Select Case UCase$(tabTmp(0))
        ' Mot clé reconnu
            Case "/PSEUDO"
                stPseudo = tabTmp(1)
                rtbWrite "Votre pseudo est " & stPseudo & ", pour le changer /pseudo <NouveauPseudo>" & vbCrLf
            Case Else
        ' Réception d'un message standard
                stEnvoi = tabLst(lgFor) & vbCrLf
        ' Ecrit les données
                rtbWrite stEnvoi
        End Select
    Next lgFor
End If
End Sub
Private Function Distribution(stTexte As String, Optional lgSauf As Long = -1)
' Envoi un texte à l'ensemble des connectés
' On peut éventuellement enlever une personne en donnant son
' indice dans le tableau
Dim lgFor As Long
For lgFor = 1 To lgConnect
    If (tabConnect(lgFor).lgRequestID > 0) And lgFor <> lgSauf Then
        wskIRC(lgFor).SendData stTexte
        DoEvents
    End If
Next lgFor
End Function
Private Function Pseudo() As String
' Création d'un pseudo temporaire pour les nouveaux connectés
Dim lgFor As Long
Dim blOK As Boolean
Dim stTmp As String
stTmp = "00"
Do
    blOK = True
' Incrémente au fur et à mesure Nouveau01, Nouveau02, Nouveau03, ...
    stTmp = "Nouveau" & Format(Val(Right$(stTmp, 2)) + 1, "00")
    For lgFor = 1 To lgConnect
        If tabConnect(lgFor).stPseudo = stTmp Then
            blOK = False
            Exit For
        End If
    Next lgFor
Loop Until blOK
Pseudo = stTmp
End Function
Private Function PseudoExiste(stPseudoReq As String) As Boolean
' Verifie l'existence d'un pseudo
Dim lgFor As Long
Dim blOK As Boolean
' Il ne faut qu'il soit vide ou pareil à celui du serveur
blOK = Not ((stPseudoReq <> vbNullString) And (UCase$(stPseudoReq) <> UCase$(stPseudo)))
For lgFor = 1 To lgConnect
    If UCase$(tabConnect(lgFor).stPseudo) = UCase$(stPseudoReq) Then
        blOK = True
        Exit For
    End If
Next lgFor
PseudoExiste = blOK
End Function


ya aprendi solo jejejj grax igual y si necesitan algo y puedo ayudarlos solo diganlo salu25

bueno freeze desde ya muchas gracias por tu compañerismo. igualmente espero no te enojes por mi interfaz.. es q soy nuevo y no sew como se el foro.... podrias ayudarme tu -Freeze-? ahh y otra pregunta encontraste el protocolo de msn q buscabas?

tienes razon -Freeze- lo lamento...