Sources

Voici les sources en VB5 d'un petit programme qui permet de creer un nouveau dossier ou l'on se

trouve

creer une feuille avec 2 boutons nommes command1(0) et command1(1) 3 labels nommes label1, label2,

label3

et un texte nomme text1.

On peur par exemple

Dans la base de registre HKEY_CLASSES_ROOT\Directory\shell\

creer une nouvel cle ndossier ensuite Command et dans defaut

 modifier ecrire c:\chemin ou se trouve le programme\ndossier.exe %1

'Programme ecrit et réalisé par Jeanbi

Private Sub Command1_Click(Index As Integer)

Dim ndossier

Select Case Index

Case 0

End

Case 1

On Error GoTo errexecution

ndossier = Label2.Caption

If Len(ndossier) = 3 Then

ndossier = ndossier + Text1.Text

Command1(0).Visible = False

Command1(1).Visible = False

Command1(2).Visible = True

'créer le répertoire

MkDir ndossier

ElseIf Len(ndossier) > 3 Then

ndossier = ndossier + "\" + Text1.Text

Command1(0).Visible = False

Command1(1).Visible = False

Command1(2).Visible = True

'créer le répertoire

MkDir ndossier

End If

Label1.Caption = "Votre nouveau dossier"

Label2.Caption = ndossier

Label3.Caption = "est créé"

Text1.Visible = False

Case 2

End

End Select

errexecution:

If Err = 75 Then

msg = MsgBox("Vous n'avez pas entré de nom de dossier", vbCritical, "Erreur ")

Command1(0).Visible = True

Command1(1).Visible = True

Command1(2).Visible = False

Exit Sub

End If

End Sub

Private Sub Form_Load()

centrer_feuille Me

Label2.Caption = CurDir

End Sub

Private Sub centrer_feuille(frm As Form)

frm.Top = Screen.Height / 2 - frm.Height / 2

frm.Left = Screen.Width / 2 - frm.Width / 2

End Sub

Une API bien pratique

SHFileOperation : Declare Function SHFileOperation Lib "shell32.dll" _ Alias "SHFileOperationA"

(lpFileOp As SHFILEOPSTRUCT) As Long

J'ai trouver cette Api sur le Net car dans les livre ou l'aide de VB il n'en n'est fait nullement cas

Elle permet de copier un fichier un repertoire ce que ne

peut faire la commande Filecopy.

L'exemple est compose de 2 label, 2 texte, 2 boutons

Option Explicit

' Exemple de programme de copy

'Private Type SHFILEOPSTRUCTURE

 hwnd As Long

 wFunc As Long

 pFrom As String

 pTo As String

 fFlags As Integer

 fAnyOperationsAborted As Boolean

 hNameMappings As Long

 lpszProgressTitle As String ' only used if FOF_SIMPLEPROGRESS

End Type

' // Shell File Operations

Const FO_MOVE = &H1

Const FO_COPY = &H2

Const FO_DELETE = &H3

Const FO_RENAME = &H4

Const FOF_MULTIDESTFILES = &H1

Const FOF_CONFIRMMOUSE = &H2

Const FOF_SILENT = &H4 ' don't create progress/report

Const FOF_RENAMEONCOLLISION = &H8

Const FOF_NOCONFIRMATION = &H10 ' Don't prompt the user.

Const FOF_WANTMAPPINGHANDLE = &H20 ' Fill in SHFILEOPSTRUCTURE.hNameMappings

 ' Must be freed using SHFreeNameMappings

Const FOF_ALLOWUNDO = &H40

Const FOF_FILESONLY = &H80 ' on *.*, do only files - not directories

Const FOF_SIMPLEPROGRESS = &H100 ' means don't show names of files

Const FOF_NOCONFIRMMKDIR = &H200 don't confirm making any needed dirsConst PO_DELETE = &H13

' printer is being deleted

Const PO_RENAME = &H14 ' printer is being renamed

Const PO_PORTCHANGE = &H20 ' port this printer connected to is being changed

 ' if this id is set, the strings received by

 ' the copyhook are a doubly-null terminated

 ' list of strings. The first is the printer

 ' name and the second is the printer port.

Const PO_REN_PORT = &H34 ' PO_RENAME and PO_PORTCHANGE at same time.

Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" _

 (lpFileOp As SHFILEOPSTRUCTURE) As Long

Private Sub Command1_Click()

 Dim lResult As Long, SHF As SHFILEOPSTRUCTURE

 SHF.hwnd = hwnd

 SHF.wFunc = FO_COPY

 SHF.pFrom = txtFrom.Text

 SHF.pTo = txtTo.Text

 SHF.fFlags = FOF_FILESONLY

 lResult = SHFileOperation(SHF)

 If lResult Then

 MsgBox "Error occurred!", vbInformation, "SHCOPY"

 End If

End Sub

Private Sub Command2_Click()

End

End Sub

Private Sub Form_Load()

 Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2

End Sub

Les sources du programme en delphi 6.0 "Gestion des mots de passe"

Le programme se compose de 3 labels + 3 edits et de 5 bouttons

Ce programe peut servir à beaucoup de chose en y apportant quelques modifications vous pouvez

en faire un carnet d'adresse etc...

unit motpasse;

interface

uses

 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

 Dialogs, StdCtrls,shellapi, ExtCtrls,Buttons;

type

 TForm1 = class(TForm)

 Label1: TLabel;

 Label2: TLabel;

 Label3: TLabel;

 Site: TEdit;

 login: TEdit;

 mot: TEdit;

 Premier: TBitBtn;

 precedent: TBitBtn;

 suivant: TBitBtn;

 dernier: TBitBtn;

 Quitter: TBitBtn;

 BitBtn1: TBitBtn;

 BitBtn2: TBitBtn;

 Label4: TLabel;

 procedure FormActivate(Sender: TObject);

 procedure PremierClick(Sender: TObject);

 procedure dernierClick(Sender: TObject);

 procedure suivantClick(Sender: TObject);

 procedure precedentClick(Sender: TObject);

 procedure QuitterClick(Sender: TObject);

 procedure BitBtn1Click(Sender: TObject);

 procedure BitBtn2Click(Sender: TObject);

 private

 { Private declarations }

 public

 { Public declarations }

 end;

Type

 Adr = record

 N : String[20];

 S : String[80];

 M : String[40];

 end;

var

 Form1: TForm1;

 repert:string;

 F : File of Adr;

 Enreg : Adr;

 Table : Array[1..100] of Adr;

 NE : LongInt; { Numéro de l'enregistrement courant }

 NbEnr : Integer; { Nombre d'enregistrements }

 I : Integer;

implementation

{$R *.dfm}

 Function GetCurrentDossier :string;

{Pour obtenir le dossier courrant}

var

 Dossier: ARRAY [0..MAX_PATH] OF Char;

begin

 if GetCurrentDirectory (SizeOf(Dossier),dossier)<>0 then Result:=strpas(Dossier);

end;

procedure Affiche(Enr : Integer);

begin

 Form1.Site.Text:=Table[Enr].S;

 Form1.mot.Text:=Table[Enr].N;

 Form1.login.Text:=Table[Enr].M;

end;

procedure enregistre;

begin

table[NE].S:=form1.Site.text;

table[NE].N:=form1.mot.text;

table[NE].M:=form1.login.text;

end;

 procedure TForm1.FormActivate(Sender: TObject);

begin

 mot.Clear;

 repert := getcurrentdossier;

 AssignFile(F,repert+'\login.dat');

 {$I-}

 Reset(F);

 {$I+}

 NE:=1;

 if IOResult=0 then

 begin

 Repeat

 Read(F,Enreg);

 Table[NE]:=Enreg;

 NE:=NE+1;

 Until Eof(F);

 NbEnr:=NE-1; { Nombre d'enregistrements dans le fichier }

 CloseFile(F);

 NE:=1; { Numéro de l'enregistrement courant }

 Affiche(NE); { Affichage du 1er enregistrement }

end

 else

 begin

 With Enreg do

 begin

 Table[1].S:='';

 Table[1].N:='';

 Table[1].M:='';

 end;

 NbEnr:=1;

 end;

end;

 procedure TForm1.SuivantClick(Sender: TObject);

begin

 Enregistre;

 NE:=NE+1;

 If (NE<=NbEnr)

 then Affiche(NE)

 else

 begin

 site.Clear;

 login.Clear;

 mot.Clear;

 NbEnr:=NbEnr+1;

 end;

end;

procedure TForm1.PrecedentClick(Sender: TObject);

begin

 If (NE>1) then

 begin

 Enregistre;

 NE:=NE-1;

 Affiche(NE);

 end;

end;

procedure TForm1.PremierClick(Sender: TObject);

begin

 Enregistre;

 NE:=1;

 Affiche(NE);

end;

procedure TForm1.DernierClick(Sender: TObject);

begin

 Enregistre;

 NE:=NbEnr;

 Affiche(NE);

end;

procedure TForm1.QuitterClick(Sender: TObject);

begin

if (login.Text + mot.Text + site.Text <>'')

 then Enregistre;

 Rewrite(F);

 For I:=1 to NbEnr do

 Write(F,Table[I]);

 CloseFile(F);

 Application.Terminate;

end;

procedure TForm1.BitBtn1Click(Sender: TObject);

var

rep:string;

begin

rep:=InputBox('Veuillez entrer', 'Votre code', 'Chaîne par défaut');

 if rep ='1954' then

 form1.mot.passwordchar:=#0;

 begin

 if rep<>'1954' then

 end;

end;

procedure TForm1.BitBtn2Click(Sender: TObject);

begin

form1.mot.PasswordChar:='*';

end;

end.

1 PageControl1:

 TabSheet1: TabSheet2:

 8 Label

 4 edit

2 boutton

unit ean;

interface

uses

 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

 Dialogs, StdCtrls, ComCtrls, Buttons;

type

 TForm1 = class(TForm)

 PageControl1: TPageControl;

 TabSheet1: TTabSheet;

 TabSheet2: TTabSheet;

 Label2: TLabel;

 Edit1: TEdit;

 Label4: TLabel;

 Label1: TLabel;

 Button1: TBitBtn;

 Label3: TLabel;

 Edit2: TEdit;

 Edit3: TEdit;

 Edit4: TEdit;

 button2: TBitBtn;

 Label5: TLabel;

 Label6: TLabel;

 Label7: TLabel;

 Label8: TLabel;

 procedure Button1Click(Sender: TObject);

 procedure Edit1Change(Sender: TObject);

 procedure Button2Click(Sender: TObject);

 private

 { Private declarations }

 public

 { Public declarations }

 end;

var

 Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);

var

a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,ean1,ean2,cle:int64;

a:integer;

begin

 if length(edit1.Text) < 12 then

begin

 a := 3;//(length(edit1.Text)) ;

Application.MessageBox('12 chiffres .vous devez entre 12 chiffres ','EAN13 : Erreur',Mb_OK);

 exit ;

 end;

a1:=(strtoint(copy(edit1.text,1,1)));

a2:=(strtoint(copy(edit1.text,3,1)));

a3:=(strtoint(copy(edit1.text,5,1)));

a4:=(strtoint(copy(edit1.text,7,1)));

a5:=(strtoint(copy(edit1.text,9,1)));

a6:=(strtoint(copy(edit1.text,11,1)));

ean1:=a1+a2+a3+a4+a5+a6;

a7:=(strtoint(copy(edit1.text,2,1)));

a8:=(strtoint(copy(edit1.text,4,1)));

a9:=(strtoint(copy(edit1.text,6,1)));

a10:=(strtoint(copy(edit1.text,8,1)));

a11:=(strtoint(copy(edit1.text,10,1)));

a12:=(strtoint(copy(edit1.text,12,1)));

ean2:=a7+a8+a9+a10+a11+a12;

cle:=10 -((ean1)+(ean2*3))mod 10;

//label1.Caption:=inttostr(cle);

 if cle=10 then cle:= 0;

label1.Caption:=(edit1.Text)+ ' ' +inttostr(cle);

end;

procedure TForm1.Edit1Change(Sender: TObject);

var

a:integer;

beginif length(edit1.Text) > 12 then

begin

Application.MessageBox('12 chiffres Max. j''efface les chiffres en trop','EAN13 : Erreur',Mb_OK);

edit1.Text:=copy(edit1.Text,1,12);

 end;

end;

procedure TForm1.Button2Click(Sender: TObject);

var

a,b,c,d,e,f,g,h,i:int64 ;

 c1:string;

begin

a:=strtoint64(edit2.text);

b:=strtoint64(edit3.Text);

//c:=high(longword);

c1:=(edit4.Text);

c:=(strtoint64(c1));

 // integer

 d:=a*8;

 a:= d div 97;

 a:= d-(a*97);

 e:=b*15;

 b:=(e div 97);

 b:=97-(e-(b*97));

 f:=(c*3);

 c:=f div 97;

 c:=97-(f-(c*97));

g:=a+b+c;

 h:=(g div 97);

 i:=g-(h*97) ;

 if i=0 then i:=97;

 label3.Caption:= inttostr(i);

// edit5.Text:= i;

end;

end.