DaRkS.222

Bom vamos ao que fazer...

 

crie um botão escrito "Iniciar GC" e adicione esse codigo nele:

 

crie outro botão escrito "primeiro" e adicione esse codigo nele:

 

crie outro botão escrito "segundo" e adicione esse codigo nele:

 

crie outro botão escrito "sair" e adicione esse codigo nele:

 

adicione tudo como esta no code abaixo (sera a mensagem de boas vindas q você podera por:

 

crie outro botão escrito "créditos" e adicione esse codigo nele:

 

agora crie um timer... de 2 clique nele e adicione esse codigo:

 

depois na barra latera direita existem algumas opções do time...dei-as assim:

 

Enabled | False

Index |

Interval | 1000

Left | 1800

Tag |

Top | 1200

 

depois de fazer tudo citado acima clique em File e depois Make Project.exe...

 

ai eh soh postar onde kiser...

 

abraçosss a todos...

 

Créditos: ~~DaRkS.222~~

aewwwww...

 

alguem vai fazer uhsushsuhs...

 

po kra vc nunk mais entro no msn ou troco de msn?

 

abraçosssss

 

fuizzzzz

tbm axei legal...ira ajudar algumas pessoas...

 

abraçossss

 

fuizzzzz

eh...tava sempre acustuma a flar :)

 

mas agora eu irei fazer tdo direito para poder fazer com q essa area fike kda veiz melhor...

 

abraçosssss

 

fuizzzzz

kra ele leenchou msm...

axu q devia suspender quem fez esse topico...

issu sim :P

 

abraços

o melhor eh q saum somente 300 MB ;)

 

abraçosssss

po eu pego mta coisas usando e pesquisando no google...

 

qualquer coisa me add msn: [email protected]

vlw :P mas jah consegui a tempo e eskeci d flar...

 

abraçõs

Nick: DaRkS

Tamanho: A escolha e naum mto pequeno uns 300 pixels esta bom

Tema: algum super heroi como superman, Batman, arqueiro verde ou Flash (pode fazer a sing com um e o avatar com outro)

Preferencia: O melhor q tiver ;)

 

uma Fan bar em formato diferente e com a imagem de um dos herois citados acima ;)

 

abraços

eh delph eh fods msm... no começo eu tbm ficava mto confuso...

mas ateh hj ainda naum sei nem a metade... eh mta coisa :P

veja: http://www.webcheats.com.br/forum/index.php?showtopic=54708

<div align='center'>O Borland Developer Studio 2006 naum é um programa e sim um pack de programas

 

Neste pack estão inclusos

 

Borland Delphi 7 Enterprise Edition

Microsoft Visual Basic 6.0 Enterprise Edition

Microsoft Visual C++ 6.0 Standard Edition

 

Delphi 7 = 475 MB

VB 6 = 200 MB

VC++ = 270 MB

 

1ª Parte do download:

2ª Parte do download:

3ª Parte do download:

 

Como no rapidshare depois de um tempo os links expiram e são deletados, para não precisarmos upar os links denovo, irei proteger os links contra expiração:

 

Parte 1:

Parte 2:

Parte 3:

 

-----

 

1ª Opção de vídeo aula para você aprender a extrair as 3 partes e formar o executável para instalação (Tamanho: 1,03mb):

 

Créditos da vídeo aula: dr4gunz

 

Créditos do tópico: ~~DaRkS.222~~</div>

Bom pessoal mais uma pesquisada pelo nosso querido google achei uma video do DELPHI. Espero que seja de grande ajuda a que esta querendo inciar na cultura da programação em DELPHI

 

#01Criando a pasta (diretório onde ficará armazenado a aplicação)

 

#02Conheça o Delphi

 

#03Criando a Primeira Aplicação em Delphi

 

#04Veja como inserir botões, panels e labels no formulário

 

#05Inserindo imagens no formulário

 

#06Inserindo a data e a hora na barra

de status

 

#07Criando Menus no Delphi

 

#08Alinhando componentes no Formulário

 

#09Criando a barra de status

 

#10Criando um formulário em Delphi

 

#11Chamando um formulário no Delphi

 

#12Criando um módulo de dados (para

ligar com o Banco)

 

#13Inserindo as tabelas no data módulo

 

Download do Arquivo para fazer downloads de vídeos do youtube !

 

~~DaRkS.222~~

Isso eh um projeto de AinBot de Gbound... muito util para tirar melhor conhecimento de VisualBasic

 

 

Download:

 

Abraços

 

~~DaRkS.222~~

Tabarra Bypass Open Source</span>

 

Download:

 

<span style="color:#FF00FF">Bom proveito e naum se esqueção dos créditos do meu amigo Tabarra

Download:

 

baixem, editem e ponhaum onde kiser ;)

Abrindo todos Comandos do Painel de Controle inclusive ele ^^, pelo Visual basic...

 

Para executar o painel de controle

 

Adicionar novo Hardware

 

Adicionar e remover programas

 

Data hora

 

Monitor

 

Propriedades da Internet (IE4)

 

Joystick

 

Teclado

 

Modem

 

Mouse

 

Multimidia

 

Rede

 

Senhas

 

Configurações Regionais

 

Sons

 

Sistema

 

Sao So Esses

Isso eh algo útil

para quem for fazer

programas relacionados

a coisas do winsdowns

e tudo mais...

 

Abraçossssss

 

fuizzzzz

<div align='left'>Programa para Formata Disket Com mais Eficiencia.

 

1º Crie Dois Forms, Nomeio o Form 1 para frmCleanA

e Form 2 para frmWorking

 

2º No frmCleanA Crie 2 CommandButton, Nas Propiedades Mude:

 

- Name: cmdStart

- Capiton: Start

- TabIndex: 1

 

e o Outro CommandButton Mude:

 

- Name: cmdExit

- Capiton: Exit

- TabIndex: 0

 

3º No frmCleanA Abra ah Janela de Codigo, apague tudo que estiver escrito ih Coloque o seguntei codigo:

<div class='codetop'>CODE</div><div class='codemain' style='height:200px;white-space:pre;overflow:auto'>

 

Option Explicit

 

Private Sub cmdExit_Click()

 

' ---------------------------------------------------------

' Unload this form. Now we go to Form_Unload()

' ---------------------------------------------------------

Unload frmCleanA ' deactivate this form

 

End Sub

Private Sub cmdStart_Click()

 

' ---------------------------------------------------

' Define local variables

' ---------------------------------------------------

Dim i As Integer

Dim fintResponse As Integer

Dim fstrMsgText As String

Dim GoodReturn As Boolean

Dim NoDataOnDisk As Boolean

 

' ---------------------------------------------------

' initialize variables

' ---------------------------------------------------

NoDataOnDisk = False

 

' ---------------------------------------------------

' Hide this form

' ---------------------------------------------------

frmCleanA.Hide

 

' ---------------------------------------------------

' Some say that this is very bad coding. I feel

' it gets the job done.

' ---------------------------------------------------

TryAgain:

 

fstrMsgText = ""

fstrMsgText = "Insert the disk you want cleaned into drive A: "

fintResponse = MsgBox(fstrMsgText, vbOKCancel + vbInformation + vbApplicationModal + vbDefaultButton1, "Insert disk")

 

Select Case fintResponse

Case vbOK

' verify disk is in drive A:

On Error Resume Next

IIf Dir("A:\", vbDirectory) <> "", True, False

If Err <> 0 Then GoTo TryAgain

On Error GoTo 0

 

Case vbCancel

GoTo LeaveHere

End Select

 

' ---------------------------------------------------

' See if the disk is ready

' ---------------------------------------------------

On Error Resume Next

Open "A:\X" For Output As #1

 

If Err <> 0 Then

MsgBox "Is the disk write protected?", vbOKOnly, "Disk Error"

On Error GoTo 0

GoTo TryAgain

End If

 

Close #1

On Error GoTo 0

 

' ---------------------------------------------------

' display the working form

' ---------------------------------------------------

Load frmWorking

With frmWorking.lblStatus

.Caption = "Erasing VTOC"

.Refresh

End With

 

' ---------------------------------------------------

' Build a DOS batch file to perform a quick format

' ---------------------------------------------------

BuildFormatBatFile "A:"

RunDosShell FMT_BAT_FILE, FMT_KEY_FILE

 

' ---------------------------------------------------

' Build a dummy file filled with NUll = Chr(0)

' ---------------------------------------------------

With frmWorking.lblStatus

.Caption = "Filling disk with Hex 00"

.Refresh

End With

 

GoodReturn = BuildDummyFile(0)

If Not GoodReturn Then GoTo LeaveHere

 

' ---------------------------------------------------

' Build a dummy file filled with Hex FF = Chr(255)

' ---------------------------------------------------

With frmWorking.lblStatus

.Caption = "Now filling disk with Hex FF"

.Refresh

End With

 

GoodReturn = BuildDummyFile(255)

If Not GoodReturn Then GoTo LeaveHere

 

' ---------------------------------------------------

' Build a batch file to perform a quick format

' ---------------------------------------------------

With frmWorking.lblStatus

.Caption = "Erasing VTOC again"

.Refresh

End With

 

BuildFormatBatFile "A:"

RunDosShell FMT_BAT_FILE, FMT_KEY_FILE

 

' ---------------------------------------------------

' Hide the working form and display a message box

' ---------------------------------------------------

frmWorking.Hide

MsgBox "You may now remove the diskette from drive A:"

 

 

LeaveHere:

 

' ---------------------------------------------------

' See if frmWorking was loaded. If so, then

' unload it and redisplay the original screen

' ---------------------------------------------------

For i = 0 To Forms.Count - 1

If Forms(i).Caption = "Work in progress" Then

Unload frmWorking

Set frmWorking = Nothing

Exit For

End If

Next

 

' ---------------------------------------------------

' Redisplay the original screen with little or no

' flickering.

' ---------------------------------------------------

frmCleanA.Show vbModeless

frmCleanA.Refresh

 

End Sub

 

Private Sub Form_Load()

 

' ---------------------------------------------------------

' display the form with little or no flicker

' ---------------------------------------------------------

frmCleanA.Show vbModeless

frmCleanA.Refresh

 

End Sub

 

Private Sub Form_Unload(Cancel As Integer)

 

' ---------------------------------------------------------

' free memory allocation

' ---------------------------------------------------------

Set frmCleanA = Nothing

 

End Sub

Private Sub Label2_Click()

 

End Sub</div>

 

4º No frmWorking crie um Label, nas Propiedades Mude:

 

- Name: lblStatus

- Alignmet: 2-Center

- BackColor: Coloque ah Cor Branca

- BorderStyle: 1-Fixed Sing

- TabIndex: 7

 

5º No frmWorking Abra ah Janela de Codigo, apague tudo que estiver escrito ih Coloque o seguntei codigo:

<div class='codetop'>CODE</div><div class='codemain' style='height:200px;white-space:pre;overflow:auto'>

 

Option Explicit

 

Private Sub Form_Load()

 

frmWorking.Show vbModeless

frmWorking.Refresh

 

End Sub</div>

 

6º Agora Crie 2 Modulos, Mude o Nome do 1º para basPrevInst e o 2º basSHFileOp

 

7º no basPrevInst Adicione o Seguinte Codigo:

<div class='codetop'>CODE</div><div class='codemain' style='height:200px;white-space:pre;overflow:auto'>Option Explicit

 

' ---------------------------------------------------------

' Constants and variables

' ---------------------------------------------------------

Public Const ASCII_TEST_FILE = "A:\X"

Public Const FMT_BAT_FILE = "BFormat.bat"

Public Const FMT_KEY_FILE = "BFormat.key"

 

' ---------------------------------------------------------

' Declare, Type, and variable needed to obtain

' free disk space information

' ---------------------------------------------------------

Public Type DISKSPACEINFO

RootPath As String * 3

FreeBytes As Long

TotalBytes As Long

FreePcnt As Single

UsedPcnt As Single

End Type

 

Public DskInfo As DISKSPACEINFO

 

Public Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long

 

' ------------------------------------------------------------------------

' TYPE required for SHFileOperation API call

' ------------------------------------------------------------------------

Public Type SHFILEOPSTRUCT

hwnd As Long

wFunc As Long

pFrom As String

pTo As String

fFlags As Integer

fAnyOperationsAborted As Long

hNameMappings As Long

lpszProgressTitle As String ' only used if FOF_SIMPLEPROGRESS

End Type

 

Public FileOp As SHFILEOPSTRUCT

 

' ------------------------------------------------------------------------

' Function constants

' ------------------------------------------------------------------------

Public Const FO_COPY = &H2

Public Const FO_DELETE = &H3

Public Const FO_MOVE = &H1

Public Const FO_RENAME = &H4

 

' ------------------------------------------------------------------------

' Flags that control the file operation. This member can be a

' combination of the following values:

'

' FOF_ALLOWUNDO Preserves undo information, if possible.

' FOF_CONFIRMMOUSE Not implemented.

' FOF_FILESONLY Performs the operation only on files if

' a wildcard filename (*.*) is specified.

' FOF_MULTIDESTFILES Indicates that the pTo member specifies

' multiple destination files (one for each

' source file) rather than one directory

' where all source files are to be deposited.

' FOF_NOCONFIRMATION Responds with "yes to all" for any dialog

' box that is displayed.

' FOF_NOCONFIRMMKDIR Does not confirm the creation of a new

' directory if the operation requires one to

' be created.

' FOF_RENAMEONCOLLISION Gives the file being operated on a new name

' (such as "Copy #1 of...") in a move, copy,

' or rename operation if a file of the target

' name already exists.

' FOF_SILENT Does not display a progress dialog box.

' FOF_SIMPLEPROGRESS Displays a progress dialog box, but does

' not show the filenames.

' FOF_WANTMAPPINGHANDLE Fills in the hNameMappings member.

' ------------------------------------------------------------------------

Public Const FOF_ALLOWUNDO = &H40

Public Const FOF_CONFIRMMOUSE = &H2

Public Const FOF_FILESONLY = &H80

Public Const FOF_MULTIDESTFILES = &H1

Public Const FOF_NOCONFIRMATION = &H10

Public Const FOF_NOCONFIRMMKDIR = &H200

Public Const FOF_RENAMEONCOLLISION = &H8

Public Const FOF_SILENT = &H4

Public Const FOF_SIMPLEPROGRESS = &H100

Public Const FOF_WANTMAPPINGHANDLE = &H20

 

' ------------------------------------------------------------------------

' Declares required for SHFileOperation API call

' ------------------------------------------------------------------------

Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Public Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long

Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Public Sub GetDiskSpace()

 

' ------------------------------------------------------

' Define local variables

' ------------------------------------------------------

Dim SxC As Long ' Sectors Per Cluster

Dim BxS As Long ' Bytes Per Sector

Dim NOFC As Long ' Number Of Free Clusters

Dim TNOC As Long ' Total Number Of Clusters

Dim lRetVal As Long

 

' ------------------------------------------------------

' Make API call to get disk infomation

' ------------------------------------------------------

lRetVal = GetDiskFreeSpace(DskInfo.RootPath, SxC, BxS, NOFC, TNOC)

 

' ------------------------------------------------------

' If it was a good call, then separate the information

' ------------------------------------------------------

With DskInfo

If lRetVal Then

.FreeBytes = BxS * SxC * NOFC

.TotalBytes = BxS * SxC * TNOC

.FreePcnt = ((.TotalBytes - .FreeBytes) / .TotalBytes) * 100

.UsedPcnt = (.FreeBytes / .TotalBytes) * 100

Else

.FreeBytes = 0

.TotalBytes = 0

.FreePcnt = 0

.UsedPcnt = 0

End If

End With

 

End Sub

 

Public Sub BuildFormatBatFile(sDriveLetter As String)

 

' --------------------------------------------------------

' sDriveLetter = "A:"

' --------------------------------------------------------

 

' --------------------------------------------------------

' Define local variables

' --------------------------------------------------------

Dim iFile As Integer

Dim sFormatCmd As String

 

' --------------------------------------------------------

' Initialize variables

' --------------------------------------------------------

iFile = FreeFile

sFormatCmd = "Format.com " & sDriveLetter & " /q/u<" & FMT_KEY_FILE

 

' --------------------------------------------------------

' build the DOS batch file that will do the quick format

' --------------------------------------------------------

Open FMT_BAT_FILE For Output As #iFile

Print #iFile, "@echo off"

Print #iFile, sFormatCmd

Print #iFile, "del bformat.key"

Close #iFile

 

' --------------------------------------------------------

' Build the key file that will answer the DOS Format.COM

' prompts

' --------------------------------------------------------

Open FMT_KEY_FILE For Output As #iFile

Print #iFile, vbCrLf & vbCrLf & "n" & vbCrLf

Close #iFile

 

End Sub

Public Sub Delay(lAmtOfDelay As Long)

 

' -----------------------------------------------------------

' This routine will cause a delay for the time requested,

' yet will not interrupt with the program progress like the

' Sleep API. The Sleep API will stop all processing while

' it is sleeping. We also do not need a timer control.

'

' Parameters:

' lAmtOfDelay - amount of time to delay

' -----------------------------------------------------------

 

' -----------------------------------------------------------

' Define local variables

' -----------------------------------------------------------

Dim vDelayTime As Variant

 

' -----------------------------------------------------------

' Determine the length of time to delay using the

' VB DateAdd function. These options could also be

' variables.

'

' "s" - seconds

' "n" - minutes

' "h" - hours

'

' We are adding the amount of delay to the current time

' -----------------------------------------------------------

vDelayTime = DateAdd("s", lAmtOfDelay, Now)

 

' -----------------------------------------------------------

' Loop thru and continualy check the curent time with the

' calculated time so we know when to leave

' -----------------------------------------------------------

Do

If Now < vDelayTime Then

' Let the application do its work

DoEvents

Else

Exit Do

End If

Loop

 

End Sub

Public Function FileExist(Filename As String) As Boolean

 

' -----------------------------------------------------------

' If there is an error, ignore it

' -----------------------------------------------------------

On Error Resume Next

 

' -----------------------------------------------------------

' See if the File exist then return TRUE else FALSE

' -----------------------------------------------------------

FileExist = IIf(Dir(Filename) <> "", True, False)

 

' -----------------------------------------------------------

' Nullify the "On Error" routine now that we are

' finished here

' -----------------------------------------------------------

On Error GoTo 0

 

End Function

 

Public Function BuildDummyFile(iChar As Integer) As Boolean

 

On Error GoTo Data_Errors

' ---------------------------------------------------

' Define local variables

' ---------------------------------------------------

Dim iFile As Integer

Dim i As Integer

Dim sRec1 As String

Dim sRec2 As String

Dim sMsg As String

Dim lBuffersize As Long

 

' ---------------------------------------------------

' initialize variables

' ---------------------------------------------------

sMsg = "" ' Empty the error message string

iFile = FreeFile ' get first available file handle

lBuffersize = 1457664 ' Max size of 1.44mb disk in bytes

 

' 2 bytes short to accomodate the carriage return and linefeed

' that VB adds when a record is written to a file

sRec1 = String(32766, iChar)

sRec2 = String(15870, iChar)

 

' ------------------------------------------------------------

' See if we have enough free space to do our job

' ------------------------------------------------------------

DskInfo.RootPath = "A:\"

GetDiskSpace

 

' ------------------------------------------------------------

' If we have a space problem. Display a message.

' ------------------------------------------------------------

If (lBuffersize > DskInfo.FreeBytes) Then

sMsg = "Are you viewing a file on this disk with another tool? " & vbCrLf

sMsg = sMsg & "Please point the tool somewhere else or close it. " & vbCrLf & vbCrLf

sMsg = sMsg & "If not, then there may be some bad clusters here. " & vbCrLf

sMsg = sMsg & "Discard the disk or try again. Thank you."

'

MsgBox sMsg, vbQuestion + vbOKOnly, "Disk Access Error"

BuildDummyFile = False

Exit Function

End If

 

' ---------------------------------------------------

' open the new file on drive A: and write data that

' is in 32k chunks except for the last write,

' which is 15872 bytes. This way, we save on memory

' allocations.

' ---------------------------------------------------

Open ASCII_TEST_FILE For Output As #iFile

 

' write a total of 1441792 bytes

For i = 1 To 44

Print #iFile, sRec1

Next

 

' Write the last record to the disk (15872 bytes)

Print #iFile, sRec2

Close #iFile

 

' ---------------------------------------------------

' Delete the file on drive A:

' ---------------------------------------------------

Kill ASCII_TEST_FILE

 

' ---------------------------------------------------

' Now leave

' ---------------------------------------------------

BuildDummyFile = True

On Error GoTo 0 ' Nullify the "On Error" in this routine

Exit Function

 

' ---------------------------------------------------

' initialize variables

' ---------------------------------------------------

Data_Errors:

 

sMsg = "Did someone remove the disk or is it damaged? " & vbCrLf & vbCrLf

sMsg = sMsg & "Error: " & Err.Number & vbCrLf & Err.Description

 

MsgBox sMsg, vbQuestion + vbOKOnly, "Disk Access Error"

BuildDummyFile = False

Close #iFile

 

On Error GoTo 0 ' Nullify the "On Error" in this routine

 

End Function

Public Function RemoveAllData() As Boolean

 

' ---------------------------------------------------

' Define local variables

' ---------------------------------------------------

Dim lReturn As Long

 

On Error GoTo Disk_Errors

' ---------------------------------------------------

' Make source path the current directory

' ---------------------------------------------------

ChDrive "A:\"

ChDir "A:\"

 

' ---------------------------------------------------

' open the new file on drive A: and write one

' long record to it

' ---------------------------------------------------

Open "A:\X" For Output As #1

Close #1

 

' ---------------------------------------------------

' Options

' ---------------------------------------------------

With FileOp

.hwnd = 0 ' Parent window of dialog box

.wFunc = FO_DELETE ' ID the function to do a delete

.pFrom = "A:\" & Chr(0) ' ID the drive

' do not prompt the user

.fFlags = FOF_NOCONFIRMATION + FOF_NOCONFIRMMKDIR + FOF_SIMPLEPROGRESS

End With

 

' ---------------------------------------------------

' Call SHFileOperation API

' ---------------------------------------------------

lReturn = SHFileOperation(FileOp)

 

' ---------------------------------------------------

' Check the return value. If non-zero the FALSE

' ---------------------------------------------------

If lReturn <> 0 Then

MsgBox "Did not complete operation successfully."

RemoveAllData = False

Else

RemoveAllData = True

End If

 

On Error GoTo 0 ' Nullify the "On Error" in this routine

 

Exit Function

 

 

Disk_Errors:

 

MsgBox "Did not complete operation successfully." & vbCrLf & vbCrLf & _

"Error: " & Err.Number & vbCrLf & Err.Description, vbOKOnly, "Error Message"

RemoveAllData = False

On Error GoTo 0 ' Nullify the "On Error" in this routine

 

End Function

 

Public Sub RunDosShell(sBatchFile As String, sDummyFile As String)

 

' ---------------------------------------------------------

' Note: I use "Command.com /c" to prefix the batchfile.

' This ensures that the DOS window will close upon

' completion.

' ---------------------------------------------------------

Dim lRetVal As Long

 

lRetVal = Shell("Command.com /c " & sBatchFile, 0)

 

Do

If FileExist(sDummyFile) Then

Delay 5 ' Delay for 5 seconds before checking again

Else

Exit Do

End If

Loop

 

' ---------------------------------------------------------

' Now we delete the batch file

' ---------------------------------------------------------

If FileExist(sBatchFile) Then

Kill sBatchFile

End If

 

End Sub</div>

 

8º No basSHFileOp, Coloque o Outro Codigo:

<div class='codetop'>CODE</div><div class='codemain' style='height:200px;white-space:pre;overflow:auto'>Option Explicit

 

' ---------------------------------------------------------

' Constants and variables

' ---------------------------------------------------------

Public Const ASCII_TEST_FILE = "A:\X"

Public Const FMT_BAT_FILE = "BFormat.bat"

Public Const FMT_KEY_FILE = "BFormat.key"

 

' ---------------------------------------------------------

' Declare, Type, and variable needed to obtain

' free disk space information

' ---------------------------------------------------------

Public Type DISKSPACEINFO

RootPath As String * 3

FreeBytes As Long

TotalBytes As Long

FreePcnt As Single

UsedPcnt As Single

End Type

 

Public DskInfo As DISKSPACEINFO

 

Public Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long

 

' ------------------------------------------------------------------------

' TYPE required for SHFileOperation API call

' ------------------------------------------------------------------------

Public Type SHFILEOPSTRUCT

hwnd As Long

wFunc As Long

pFrom As String

pTo As String

fFlags As Integer

fAnyOperationsAborted As Long

hNameMappings As Long

lpszProgressTitle As String ' only used if FOF_SIMPLEPROGRESS

End Type

 

Public FileOp As SHFILEOPSTRUCT

 

' ------------------------------------------------------------------------

' Function constants

' ------------------------------------------------------------------------

Public Const FO_COPY = &H2

Public Const FO_DELETE = &H3

Public Const FO_MOVE = &H1

Public Const FO_RENAME = &H4

 

' ------------------------------------------------------------------------

' Flags that control the file operation. This member can be a

' combination of the following values:

'

' FOF_ALLOWUNDO Preserves undo information, if possible.

' FOF_CONFIRMMOUSE Not implemented.

' FOF_FILESONLY Performs the operation only on files if

' a wildcard filename (*.*) is specified.

' FOF_MULTIDESTFILES Indicates that the pTo member specifies

' multiple destination files (one for each

' source file) rather than one directory

' where all source files are to be deposited.

' FOF_NOCONFIRMATION Responds with "yes to all" for any dialog

' box that is displayed.

' FOF_NOCONFIRMMKDIR Does not confirm the creation of a new

' directory if the operation requires one to

' be created.

' FOF_RENAMEONCOLLISION Gives the file being operated on a new name

' (such as "Copy #1 of...") in a move, copy,

' or rename operation if a file of the target

' name already exists.

' FOF_SILENT Does not display a progress dialog box.

' FOF_SIMPLEPROGRESS Displays a progress dialog box, but does

' not show the filenames.

' FOF_WANTMAPPINGHANDLE Fills in the hNameMappings member.

' ------------------------------------------------------------------------

Public Const FOF_ALLOWUNDO = &H40

Public Const FOF_CONFIRMMOUSE = &H2

Public Const FOF_FILESONLY = &H80

Public Const FOF_MULTIDESTFILES = &H1

Public Const FOF_NOCONFIRMATION = &H10

Public Const FOF_NOCONFIRMMKDIR = &H200

Public Const FOF_RENAMEONCOLLISION = &H8

Public Const FOF_SILENT = &H4

Public Const FOF_SIMPLEPROGRESS = &H100

Public Const FOF_WANTMAPPINGHANDLE = &H20

 

' ------------------------------------------------------------------------

' Declares required for SHFileOperation API call

' ------------------------------------------------------------------------

Public Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long

Public Declare Function GetTempFileName Lib "kernel32" Alias "GetTempFileNameA" (ByVal lpszPath As String, ByVal lpPrefixString As String, ByVal wUnique As Long, ByVal lpTempFileName As String) As Long

Public Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Public Sub GetDiskSpace()

 

' ------------------------------------------------------

' Define local variables

' ------------------------------------------------------

Dim SxC As Long ' Sectors Per Cluster

Dim BxS As Long ' Bytes Per Sector

Dim NOFC As Long ' Number Of Free Clusters

Dim TNOC As Long ' Total Number Of Clusters

Dim lRetVal As Long

 

' ------------------------------------------------------

' Make API call to get disk infomation

' ------------------------------------------------------

lRetVal = GetDiskFreeSpace(DskInfo.RootPath, SxC, BxS, NOFC, TNOC)

 

' ------------------------------------------------------

' If it was a good call, then separate the information

' ------------------------------------------------------

With DskInfo

If lRetVal Then

.FreeBytes = BxS * SxC * NOFC

.TotalBytes = BxS * SxC * TNOC

.FreePcnt = ((.TotalBytes - .FreeBytes) / .TotalBytes) * 100

.UsedPcnt = (.FreeBytes / .TotalBytes) * 100

Else

.FreeBytes = 0

.TotalBytes = 0

.FreePcnt = 0

.UsedPcnt = 0

End If

End With

 

End Sub

 

Public Sub BuildFormatBatFile(sDriveLetter As String)

 

' --------------------------------------------------------

' sDriveLetter = "A:"

' --------------------------------------------------------

 

' --------------------------------------------------------

' Define local variables

' --------------------------------------------------------

Dim iFile As Integer

Dim sFormatCmd As String

 

' --------------------------------------------------------

' Initialize variables

' --------------------------------------------------------

iFile = FreeFile

sFormatCmd = "Format.com " & sDriveLetter & " /q/u<" & FMT_KEY_FILE

 

' --------------------------------------------------------

' build the DOS batch file that will do the quick format

' --------------------------------------------------------

Open FMT_BAT_FILE For Output As #iFile

Print #iFile, "@echo off"

Print #iFile, sFormatCmd

Print #iFile, "del bformat.key"

Close #iFile

 

' --------------------------------------------------------

' Build the key file that will answer the DOS Format.COM

' prompts

' --------------------------------------------------------

Open FMT_KEY_FILE For Output As #iFile

Print #iFile, vbCrLf & vbCrLf & "n" & vbCrLf

Close #iFile

 

End Sub

Public Sub Delay(lAmtOfDelay As Long)

 

' -----------------------------------------------------------

' This routine will cause a delay for the time requested,

' yet will not interrupt with the program progress like the

' Sleep API. The Sleep API will stop all processing while

' it is sleeping. We also do not need a timer control.

'

' Parameters:

' lAmtOfDelay - amount of time to delay

' -----------------------------------------------------------

 

' -----------------------------------------------------------

' Define local variables

' -----------------------------------------------------------

Dim vDelayTime As Variant

 

' -----------------------------------------------------------

' Determine the length of time to delay using the

' VB DateAdd function. These options could also be

' variables.

'

' "s" - seconds

' "n" - minutes

' "h" - hours

'

' We are adding the amount of delay to the current time

' -----------------------------------------------------------

vDelayTime = DateAdd("s", lAmtOfDelay, Now)

 

' -----------------------------------------------------------

' Loop thru and continualy check the curent time with the

' calculated time so we know when to leave

' -----------------------------------------------------------

Do

If Now < vDelayTime Then

' Let the application do its work

DoEvents

Else

Exit Do

End If

Loop

 

End Sub

Public Function FileExist(Filename As String) As Boolean

 

' -----------------------------------------------------------

' If there is an error, ignore it

' -----------------------------------------------------------

On Error Resume Next

 

' -----------------------------------------------------------

' See if the File exist then return TRUE else FALSE

' -----------------------------------------------------------

FileExist = IIf(Dir(Filename) <> "", True, False)

 

' -----------------------------------------------------------

' Nullify the "On Error" routine now that we are

' finished here

' -----------------------------------------------------------

On Error GoTo 0

 

End Function

 

Public Function BuildDummyFile(iChar As Integer) As Boolean

 

On Error GoTo Data_Errors

' ---------------------------------------------------

' Define local variables

' ---------------------------------------------------

Dim iFile As Integer

Dim i As Integer

Dim sRec1 As String

Dim sRec2 As String

Dim sMsg As String

Dim lBuffersize As Long

 

' ---------------------------------------------------

' initialize variables

' ---------------------------------------------------

sMsg = "" ' Empty the error message string

iFile = FreeFile ' get first available file handle

lBuffersize = 1457664 ' Max size of 1.44mb disk in bytes

 

' 2 bytes short to accomodate the carriage return and linefeed

' that VB adds when a record is written to a file

sRec1 = String(32766, iChar)

sRec2 = String(15870, iChar)

 

' ------------------------------------------------------------

' See if we have enough free space to do our job

' ------------------------------------------------------------

DskInfo.RootPath = "A:\"

GetDiskSpace

 

' ------------------------------------------------------------

' If we have a space problem. Display a message.

' ------------------------------------------------------------

If (lBuffersize > DskInfo.FreeBytes) Then

sMsg = "Are you viewing a file on this disk with another tool? " & vbCrLf

sMsg = sMsg & "Please point the tool somewhere else or close it. " & vbCrLf & vbCrLf

sMsg = sMsg & "If not, then there may be some bad clusters here. " & vbCrLf

sMsg = sMsg & "Discard the disk or try again. Thank you."

'

MsgBox sMsg, vbQuestion + vbOKOnly, "Disk Access Error"

BuildDummyFile = False

Exit Function

End If

 

' ---------------------------------------------------

' open the new file on drive A: and write data that

' is in 32k chunks except for the last write,

' which is 15872 bytes. This way, we save on memory

' allocations.

' ---------------------------------------------------

Open ASCII_TEST_FILE For Output As #iFile

 

' write a total of 1441792 bytes

For i = 1 To 44

Print #iFile, sRec1

Next

 

' Write the last record to the disk (15872 bytes)

Print #iFile, sRec2

Close #iFile

 

' ---------------------------------------------------

' Delete the file on drive A:

' ---------------------------------------------------

Kill ASCII_TEST_FILE

 

' ---------------------------------------------------

' Now leave

' ---------------------------------------------------

BuildDummyFile = True

On Error GoTo 0 ' Nullify the "On Error" in this routine

Exit Function

 

' ---------------------------------------------------

' initialize variables

' ---------------------------------------------------

Data_Errors:

 

sMsg = "Did someone remove the disk or is it damaged? " & vbCrLf & vbCrLf

sMsg = sMsg & "Error: " & Err.Number & vbCrLf & Err.Description

 

MsgBox sMsg, vbQuestion + vbOKOnly, "Disk Access Error"

BuildDummyFile = False

Close #iFile

 

On Error GoTo 0 ' Nullify the "On Error" in this routine

 

End Function

Public Function RemoveAllData() As Boolean

 

' ---------------------------------------------------

' Define local variables

' ---------------------------------------------------

Dim lReturn As Long

 

On Error GoTo Disk_Errors

' ---------------------------------------------------

' Make source path the current directory

' ---------------------------------------------------

ChDrive "A:\"

ChDir "A:\"

 

' ---------------------------------------------------

' open the new file on drive A: and write one

' long record to it

' ---------------------------------------------------

Open "A:\X" For Output As #1

Close #1

 

' ---------------------------------------------------

' Options

' ---------------------------------------------------

With FileOp

.hwnd = 0 ' Parent window of dialog box

.wFunc = FO_DELETE ' ID the function to do a delete

.pFrom = "A:\" & Chr(0) ' ID the drive

' do not prompt the user

.fFlags = FOF_NOCONFIRMATION + FOF_NOCONFIRMMKDIR + FOF_SIMPLEPROGRESS

End With

 

' ---------------------------------------------------

' Call SHFileOperation API

' ---------------------------------------------------

lReturn = SHFileOperation(FileOp)

 

' ---------------------------------------------------

' Check the return value. If non-zero the FALSE

' ---------------------------------------------------

If lReturn <> 0 Then

MsgBox "Did not complete operation successfully."

RemoveAllData = False

Else

RemoveAllData = True

End If

 

On Error GoTo 0 ' Nullify the "On Error" in this routine

 

Exit Function

 

 

Disk_Errors:

 

MsgBox "Did not complete operation successfully." & vbCrLf & vbCrLf & _

"Error: " & Err.Number & vbCrLf & Err.Description, vbOKOnly, "Error Message"

RemoveAllData = False

On Error GoTo 0 ' Nullify the "On Error" in this routine

 

End Function

 

Public Sub RunDosShell(sBatchFile As String, sDummyFile As String)

 

' ---------------------------------------------------------

' Note: I use "Command.com /c" to prefix the batchfile.

' This ensures that the DOS window will close upon

' completion.

' ---------------------------------------------------------

Dim lRetVal As Long

 

lRetVal = Shell("Command.com /c " & sBatchFile, 0)

 

Do

If FileExist(sDummyFile) Then

Delay 5 ' Delay for 5 seconds before checking again

Else

Exit Do

End If

Loop

 

' ---------------------------------------------------------

' Now we delete the batch file

' ---------------------------------------------------------

If FileExist(sBatchFile) Then

Kill sBatchFile

End If

 

End Sub</div>

 

Pronto ;D

Eu Tentei Fazer um Codigo Baseado nessa Para Disfragmentar a Unidade "C:\"

Ih Tbm Para Deletar os Arquivos que quizer nos "Cds-RW"....

Eu To Conseguindo Fazer, mais ainda tah dando alguns erros, qdo eu conseguir fazer

fucionar completamente eu Posto aki no Forum.!

.Creditos: ScriptBR

Flwz.</div>

issu ai eu peguei pela net... pq naum tive tempo de fazer projetoas novos ainda pois estou sem tempo :P

 

mas quarta feira começo pra valer...

 

postei issu aki para mostrar um pouco de serviço enquando naum estou vindo com tdo ;)

 

abraços

Vamos aprender e travar o teclado e o mouse

 

XD

 

Declare:

 

Depois de declarar ponha o seguinte codigo:

 

Explicaçao:

O codigo Sleep 10000 bloqueada o mouse e o teclado por 10 segundos, vc pode alteralo para quanto tempo vc kiser!

Bom primeiro adcione um command Buton

e coloque esse codigo

 

para alterar o site e so vc mecher nessa linha

e alterar de ftp para o site de sua preferencia

exemplo:

Ps¹: ele irar abrir pelo internet explorer se

alguem souber mais sobre o codigo e abrir pelo browser padrao e bem vindo

 

Ahhh

se vc quiser colocar no form_load e unload

tambem da

ele faz o mesmo comando so que abre o site quando vc abre o

progama

 

================================

Esse aqui quando vc fecha o progama

 

Duvidas

Poste ae

O popular jogo de cobrinha para celulares, agora em seu computador. Com um gráfico mais avançado, serve como base de aperfeiçoamento da linguagem, utiliza diversas classes e funções.

 

comente abaixo o que achou do jogo .

para fazer o downlod

cria 4 form nome: EndScreen , HlpFrm , Settings , SnakeTable

1º endscreen

 

2º hlpfm

 

 

neste form voce pode escrever sobre o programa

 

3º Settings

 

4º form SnakeTable

 

aqui fica as espricações do jogo

 

se não entedeu abaixe o arquivo zipado acima

xou de bola manow...

isso ainda pega?

se pegar parabens

abraços

quando naum funcionar vc seleciona akela caixinha "Give online..." e clica em "Upload(Inet)"

 

sempre adianta aki ;)

 

se naum poste ai...

 

abraçosssss

 

fuizzzzz

1º eu queria que vcs criacem a area WC criação... para postagem de programas e outras coisas relacionadas a WC...

2º queria me candidatar a Programador para ajdar mais ainda a WC...

 

abraçosssss

 

fuizzzzz