|
 Trouver une ressource
Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !
 Sujet : convertir programme delphi en programme vb [ Algorithme / Compression & Cryptage ] (simo0506)
 Informations & options pour cette discussion
mardi 8 avril 2008 à 00:29:40 |
convertir programme delphi en programme vb
simo0506
|
salut a tous ,s'il vous plait : j'ai un programme en language delphi et je veux le convrtir en language vb.net le programme est: - program Hamming;
- uses SysUtils;
- (* ========================================================= *)
- (* *)
- (* Méthode de Hamming: transmission de données sans erreur *)
- (* © Tanguy Altert, http://altert.family.free.fr/ *)
- (* *)
- (* Août 2005 *)
- (* *)
- (* ========================================================= *)
- {$APPTYPE Console}
- const BPower : array[0..7] of byte = (1, 2, 4, 8, 16, 32, 64, 128);
- BinChar : packedarray[boolean] of char = '01';
- Separator = '=============================================';
- type THData = string[8];
- var Texte : string;
- Orn : byte;
- BinMem : string;
- BinBuff : string;
- BinDump : string;
- BinHamg : string;
- ModifCount : integer;
- HammingIn : array[1..4] of boolean;
- HammingOut : array[1..8] of boolean;
- idx, pw : integer;
- bool : boolean;
- s : string;
- WillRepair : boolean;
- (***************************************************************************)
- (* Cette partie simule un correspondant distant recevant les données. *)
- (* Le corps principal du programme n'est pas censé pouvoir modifier *)
- (* directement les variables suivantes (d'où l'utilisation de procédures *)
- (* telles que SetRepair. Cela simule des conversations sur un réseau. *)
- var PackCount, ErrorCount : integer;
- HMsg : string;
- DoRepair : boolean;
- procedure RevTransf;
- begin
- HammingIn[1]:=HammingOut[1] xor HammingOut[2] xor HammingOut[5];
- HammingIn[2]:=HammingOut[3] xor HammingOut[4] xor HammingOut[6];
- HammingIn[3]:=HammingOut[1] xor HammingOut[3] xor HammingOut[7];
- HammingIn[4]:=HammingOut[2] xor HammingOut[4] xor HammingOut[8];
- end;
- procedure SetRepair(State:boolean);
- begin
- DoRepair:=State;
- end;
- procedure Init;
- begin
- PackCount:=0;
- ErrorCount:=0;
- DoRepair:=false;
- HMsg:='';
- end;
- procedure Send(Data:THData);
- var Sgn : byte;
- EBit : byte;
- i : integer; //la variable de boucle doit être locale
- label ReCheck;
- begin
- inc(PackCount);
- //CONVERTISSONS LE SIGNAL REÇU EN TABLEAU DE BOOLÉENS
- for i:=1 to 8 do
- HammingOut[i]:= Data[i]='1';
- ReCheck:
- RevTransf;
- //REPÉRONS LA SIGNATURE (EN BINAIRE INVERSÉ)
- Sgn:=0;
- for i:=1 to 4 do
- Sgn:=Sgn+ Ord(HammingIn[i]) * BPower[i-1];
- //CORRECTION DU SIGNAL [1, 2, 4, 8, 16, 32, 64, 128]
- case Sgn of
- 0 {0000}: EBit:=0; //le signal est OK !
- 1 {1000}: EBit:=5;
- 2 {0100}: EBit:=6;
- 4 {0010}: EBit:=7;
- 5 {1010}: EBit:=1;
- 6 {0110}: EBit:=3;
- 8 {0001}: EBit:=8;
- 9 {1001}: EBit:=2;
- 10 {0101}: EBit:=4;
- else EBit:=0; //pas de correction possible
- end;
- if EBit>0 then
- begin
- inc(ErrorCount);
- WriteLn(' Erreur sur le bit N°',EBit,' du paquet N°',PackCount,' envoyé');
- if DoRepair then
- begin
- HammingOut[EBit]:=not HammingOut[EBit]; //le HammingIn a juste servi comme détecteur d'erreur et pas comme le décompilé du HammingOut
- goto ReCheck;
- end;
- end;
- //MÉMORISATION DU PAQUET
- for i:=1 to 4 do
- HMsg:=HMsg+ BinChar[HammingOut[i]];
- end;
- procedure Final;
- var i : integer;
- begin
- WriteLn('Le correspondant a reçu ',PackCount,' paquets, soit ',8*PackCount,' bits.');
- case ErrorCount of
- 0: WriteLn('Aucune erreur n''a été détectée.');
- 1: WriteLn(ErrorCount,' erreur a été détectée.');
- else WriteLn(ErrorCount,' erreurs ont été détectées.');
- end;
- WriteLn;
- WriteLn('Le message binaire reçu est :');
- WriteLn(HMsg);
- WriteLn;
- WriteLn('Il correspond au message original suivant :');
- //ON DECODE LE DUMP BINAIRE
- BinBuff:=HMsg;
- Texte:='';
- repeat
- BinMem:=Copy(BinBuff,1,8);
- Orn:=0;
- for i:=1 to 8 do
- Orn:=Orn + BPower[i-1]*StrToInt(BinMem[i]);
- Texte:=Texte + Chr(Orn);
- Delete(BinBuff,1,8);
- until BinBuff='';
- WriteLn(Texte);
- end;
- (* *)
- (* *)
- (* *)
- (**************************************************************************)
- label ReDo;
- begin
- //TITRE
- WriteLn('Méthode de Hamming : transmission de données sans erreur');
- WriteLn(Separator);
- WriteLn;
- //SAISIE DU TEXTE
- ReDo:
- SetRepair(false);
- WriteLn('Saisissez le texte à transmettre virtuellement :');
- ReadLn(Texte);
- //DUMP BINAIRE
- BinDump:='';
- for idx:=1 to Length(Texte) do
- begin
- Orn:=Ord(Texte[idx]);
- for pw:=0 to 7 do
- BinDump:=BinDump + BinChar[Orn and BPower[pw]>0];
- //ATTENTION: c'est un dump binaire inversé, c'est à dire que 2^0 se trouve à gauche et 2^7 à droite
- end;
- WriteLn;
- WriteLn(Separator);
- WriteLn('L''anti-dump binaire associé est :');
- WriteLn(BinDump);
- //TRAITEMENT DU SIGNAL
- BinHamg:='';
- BinBuff:=BinDump;
- repeat
- //on traite les données par 4 bits (c'est pourquoi on a dumpé en binaire)
- BinMem:=Copy(BinBuff,1,4);
- for idx:=1 to 4 do
- HammingIn[idx]:= BinMem[idx]='1';
- //transformation mathématique
- HammingOut[1]:=HammingIn[1];
- HammingOut[2]:=HammingIn[2];
- HammingOut[3]:=HammingIn[3];
- HammingOut[4]:=HammingIn[4];
- HammingOut[5]:=HammingIn[1] xor HammingIn[2];
- HammingOut[6]:=HammingIn[3] xor HammingIn[4];
- HammingOut[7]:=HammingIn[1] xor HammingIn[3];
- HammingOut[8]:=HammingIn[2] xor HammingIn[4];
- //constitution du signal de sortie et effacement du premier paquet de 4 bits situé au début
- for idx:=1 to 8 do
- BinHamg:=BinHamg + BinChar[HammingOut[idx]];
- Delete(BinBuff,1,4);
- until BinBuff='';
- WriteLn;
- WriteLn('Le signal de Hamming associé est :');
- WriteLn(BinHamg);
- //Naturellement, le dump de Hamming est deux fois plus lourd que le dump binaire.
- //Il reste quand même un avantage: il est possible de réparer le signal s'il y a
- //des erreurs, ce que ne permet pas un simple dump binaire.
- //POSSIBILITE DE MODIFIER LE DUMP
- WillRepair:=false;
- WriteLn;
- WriteLn('Le but de ce code est de détecter les erreurs de transmission.');
- WriteLn('Vous pouvez modifier quelques bits de Hamming, mais vous allez');
- WriteLn('vous faire griller lors de la réception (sauf s''il y a');
- WriteLn('compensation des erreurs)...');
- WriteLn;
- Write ('Voulez-vous modifier des bits ? (oui/non) ');
- ReadLn(s);
- if LowerCase(s)='oui' then
- begin
- WriteLn;
- WriteLn('Tapez "-1" pour arrêter. Sachez qu''il y a ',Length(BinHamg),' bits dans le message...');
- ModifCount:=0;
- bool:=false;
- repeat
- Write(' Bit N°');
- ReadLn(idx);
- if (idx=-1) or (idx>Length(BinHamg)) then
- bool:=true
- else
- begin
- BinHamg[idx]:=BinChar[not boolean(StrToInt(BinHamg[idx]))];
- inc(ModifCount);
- end;
- until bool;
- WriteLn;
- WriteLn(ModifCount,' bits du signal ont été modifiés...');
- WriteLn;
- WriteLn(Separator);
- WriteLn('Le signal de Hamming est maintenant celui-ci :');
- WriteLn(BinHamg);
- if ModifCount>0 then
- begin
- WriteLn;
- WriteLn('Vous avez la possibilité d''activer le correcteur d''erreur.');
- Write ('Souhaitez-vous le faire ? (oui/non) ');
- ReadLn(s);
- WillRepair:= LowerCase(s)='oui';
- end;
- end;
- //ENVOI DU MESSAGE
- WriteLn;
- WriteLn(Separator);
- Init;
- SetRepair(WillRepair);
- BinBuff:=BinHamg;
- repeat
- Send(Copy(BinBuff,1,8));
- Delete(BinBuff,1,8);
- until BinBuff='';
- //FINALISATION DU TRAITEMENT ET PURGE DE LA MEMOIRE
- WriteLn;
- WriteLn(Separator);
- Final;
- BinMem:='';
- BinBuff:='';
- BinDump:='';
- BinHamg:='';
- //POSSIBILITE DE RECOMMENCER
- WriteLn;
- WriteLn(Separator);
- Write('Souhaitez-vous recommencer ce test très convaincant ? (oui/non) ');
- ReadLn(s);
- if LowerCase(s)='oui' then
- begin
- for idx:=1 to 5 do
- WriteLn;
- goto ReDo;
- end;
- end.
|
|
|
mardi 8 avril 2008 à 08:59:52 |
Re : convertir programme delphi en programme vb
|
Cette discussion est classé dans : writeln, idx, hammingout, hammingin, ebit
 Répondre à ce message
 Sujets en rapport avec ce message
Creation de Colonnes Yes/No de Type CheckBox [ par Nights ]
En fait voila, j'importe un fichier texte depuis l'exterieur, ensuite je rajoute Deux colonnes a cette table.Le Code se situe apres:' Return reference
convertire du delphi en vb [ par spookie ]
salut voila je voudrai convertir envb se code unit UnitFrmMain;interfaceuses Forms, Dialogs, Menus, ToolWin, ComCtrls, Grids, StdCtrls, Controls, Cl
dupliquer controles [ par curl ]
Bonjour,Je voudrais créer une Sub pour dupliquer des controles..Voici le bout de code pour dupliquer 39 fois le controle Label 'delai' . Ldelai(0) exi
Passage d'une partie de tableau en paramètre [ par curl ]
Bonjour,N'y aurait t'il pas une syntaxe correcte pour passer ***une partie de tableau*** en paramètre ? Exemple:-------------------------------------D
Je bloque sur une Cmd VBA Outlook [ par ririJB43 ]
Bonjour à tous,J'ai chercher dans le forum, la Cmd qui me permettrait de me positionner dans le rep "spam" de la racine du dossier personnel dans Outl
--------- J'ai une partie du code qui peu m'aider pour la suite !!! [ par ririJB43 ]
Bonjour à tous,J'ai chercher dans le forum, la Cmd qui me permettrait de me positionner dans le rep "spam" de la racine du dossier personnel dans Outl
Utilisation de libraire [ par rsca_en_force ]
Bonjour donc voila j'ai un probleme de librairie voila le debut de mon programmeprogram Easy_fiche;uses crt;var titre,affiche,genre,annee,acteur,reali
Utilisation de libraire [ par rsca_en_force ]
Bonjour donc voila j'ai un probleme de librairie voila le debut de mon programmeprogram Easy_fiche;uses crt;var titre,affiche,genre,annee,acteur,reali
flash, mail et encapsuler : misssion (un) possible ?! [ par misstyff ]
voilà un joli casse tête : envoyer un mail avec un .swf qui se lit automatiquement,et voici la cerise sur le gateau (ne pas en faire une goutte d'eau
Créer une table indexée au format Paradox [ par logedu ]
J'arrive à créer une table au format Paradox, mais pas à l'indexer. Alors si quelqu'un a une idée...Voici comment je fais : Nomdb est le nom de m
 Livres en rapport
|
Comparez les prix Nouvelle version
|