SOUNDCRYPT

Commentaire de craftsystem le 24/09/2007 21:14:39

J'aimerais prochainement que le fichier sauvegarder detecte la lettre du disque dure car pour le moment il et configurer a C:\Windows

Commentaire de f0xi le 25/09/2007 02:14:42 administrateur CS

version épurée (peut y'avoir un bug, j'ai pas verifier) :


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, MPlayer, ExtCtrls, Gauges, ComCtrls,
  GraphicGauge, Menus;


type
  TForm1 = class(TForm)
    MediaPlayer1: TMediaPlayer;
    OpenDialog1: TOpenDialog;
    Label2: TLabel;
    Timer1: TTimer;
    ListBox1: TListBox;
    StatusBar1: TStatusBar;
    Panel1: TPanel;
    Gauge1: TGraphicGauge;
    PopupMenu1: TPopupMenu;
    Play1: TMenuItem;
    Stop1: TMenuItem;
    Pause1: TMenuItem;
    Shape1: TShape;
    BitBtn5: TImage;
    BitBtn4: TImage;
    BitBtn6: TImage;
    BitBtn2: TImage;
    BitBtn3: TImage;
    BitBtn1: TImage;
    Supprimer1: TMenuItem;
    Image2: TImage;
    OpenDialog3: TOpenDialog;
    Quitter1: TMenuItem;
    Shape2: TShape;
    Image3: TImage;
    procedure BitBtn5Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn4Click(Sender: TObject);
    procedure BitBtn6Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure BitBtn3Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);

    procedure Supprimer1Click(Sender: TObject);
    procedure Image2Click(Sender: TObject);
    procedure Quitter1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);

  private
    { Déclarations privées }

  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  y: byte    = 0;
  a: integer = 0;
  b: integer = 0;
  c: integer = 0;
  f: integer = 0;
  InFileName, OutFileName, Key: string;

function DecodeMPTime(const MilliSeconds : integer; out H,M,S,Z : word);
begin
  Z := MilliSeconds mod 1000;
  S := (MilliSeconds div 1000) mod 60;
  M := (MilliSeconds div 60000) mod 60;
  H := MilliSeconds div 3600000;
end;


procedure XorCypher(const InFileName, OutFileName, Key: string);
var InFlux, OutFlux: TFileStream;
  Buffer: byte;
  pKey: PChar;
  M, KeyL, KeyP: integer;
  function GetNextKey: byte;
  begin
    result := byte(pKey[KeyP]);
    KeyP := (KeyP + 1) mod KeyL;
  end;
begin
  KeyL := Length(Key);
  KeyP := 0;
  pKey := PChar(Key);

  InFlux := TFileStream.Create(InFileName, fmOpenRead);
  try

    OutFlux := TFileStream.Create(OutFileName, fmCreate);
    try

      form1.Gauge1.Progress := 0;
      form1.Gauge1.MaxValue := InFlux.Size;

      for M := 0 to InFlux.Size - 1 do
      begin
        InFlux.ReadBuffer(Buffer, 1); // on lit
        Buffer := Buffer xor GetNextKey; // on code
        OutFlux.WriteBuffer(Buffer, 1); // on ecrit

        if (M mod 5) = 0 then
        begin
          form1.Gauge1.Progress := InFlux.Position;
          application.ProcessMessages;
        end;
      end;

    finally
      OutFlux.Free;
    end;

  finally
    InFlux.Free;
  end;

  form1.Gauge1.Progress := 0;
end;

procedure TForm1.BitBtn5Click(Sender: TObject);

begin
  if ListBox1.ItemIndex = -1 then
    exit;

  if c = 1 then
    deletefile('C:\Windows\D-Krypt.wav');

  Timer1.Enabled := True;
  MediaPlayer1.Play;
  y := 1;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  fichier : ansistring;
begin
  Timer1.Enabled := not OpenDialog1.Execute;
  if not Timer1.Enabled then
  begin
    key := '33';
    InFileName  := OpenDialog1.FileName;
    OutFileName := 'C:\Windows\D-Krypt.wav';
    XorCypher(InFileName, OutFileName, key);

    fichier := 'C:\Windows\D-Krypt.wav';
    ListBox1.Items.Add('D-Krypt.wav');
    a := a + 1;

    Timer1.Enabled := y = 1;
    if not Timer1.Enabled then
    begin
      ListBox1.ItemIndex := 0;
      MediaPlayer1.Close;
      MediaPlayer1.FileName := fichier;
      MediaPlayer1.Open;
      MediaPlayer1.timeFormat := tfMilliseconds;
    end;
  end;
end;


procedure TForm1.BitBtn4Click(Sender: TObject);
begin
  if ListBox1.ItemIndex = -1 then
    exit;

  MediaPlayer1.Pause;
end;

procedure TForm1.BitBtn6Click(Sender: TObject);
begin
  if ListBox1.ItemIndex = -1 then
    exit;

  MediaPlayer1.Stop;
  MediaPlayer1.Position := 0;

  y := 0;
  f := 0;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var H,M,S,Z : word;
begin
  DecodeMPTime(MediaPlayer1.Length, H,M,S,Z);

  Label2.Caption := format('%.2d:%.2d',[M,S]);;

  Gauge1.MaxValue := MediaPlayer1.Length;
  Gauge1.Progress := MediaPlayer1.Position;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  deletefile('C:\Windows\D-Krypt.wav');
  Timer1.Enabled := false;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  a := ListBox1.ItemIndex;
  if a = -1 then
    Exit;

  MediaPlayer1.Close;
  MediaPlayer1.Enabled := True;
  MediaPlayer1.FileName := ListBox1.Items.Strings[ListBox1.ItemIndex];
  MediaPlayer1.Open;
  MediaPlayer1.timeFormat := tfMilliseconds;
  Timer1.Enabled := True;

  if y = 1 then
    MediaPlayer1.Play;
end;

procedure TForm1.BitBtn3Click(Sender: TObject);
begin
  if ListBox1.ItemIndex = -1 then
    Exit;

  if ListBox1.ItemIndex = 0 then
    ListBox1.ItemIndex := (a - 1)
  else
    ListBox1.ItemIndex := (ListBox1.ItemIndex) - 1;

  MediaPlayer1.Close;
  MediaPlayer1.FileName := ListBox1.Items.Strings[ListBox1.ItemIndex];
  MediaPlayer1.Open;
  MediaPlayer1.timeFormat := tfMilliseconds;

  if y = 1 then
    MediaPlayer1.Play;
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  if ListBox1.ItemIndex = -1 then
    exit;

  if (ListBox1.ItemIndex + 1) = a  then
    ListBox1.ItemIndex := -1;

  ListBox1.ItemIndex := ((ListBox1.ItemIndex) + 1);
  MediaPlayer1.Close;
  MediaPlayer1.FileName := ListBox1.Items.Strings[ListBox1.ItemIndex];
  MediaPlayer1.Open;
  MediaPlayer1.timeFormat := tfMilliseconds;

  if y = 1 then
    MediaPlayer1.Play;
end;

procedure TForm1.Supprimer1Click(Sender: TObject);
begin
  listbox1.Items.Clear;
end;

procedure TForm1.Image2Click(Sender: TObject);
begin
  Timer1.Enabled := not OpenDialog3.Execute;

  if not Timer1.Enabled then
  begin
    Caption := OpenDialog3.FileName;
    ListBox1.Items.Add(OpenDialog3.FileName);
    a := a + 1;
    Timer1.Enabled := y = 1;
    if not Timer1.Enabled then
    begin
      ListBox1.ItemIndex := 0;
      MediaPlayer1.Close;
      MediaPlayer1.FileName := ListBox1.Items.Strings[ListBox1.ItemIndex];
      MediaPlayer1.Open;
      MediaPlayer1.timeFormat := tfMilliseconds;
    end;
  end;
end;

procedure TForm1.Quitter1Click(Sender: TObject);
begin
  listbox1.Items.Clear;
  MediaPlayer1.Close;
  Timer1.Enabled := false;
  Close;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DeleteFile('C:\Windows\D-Krypt.wav');
end;

end.


et merci de me citer dans la source pour XorCypher ... ;)

Commentaire de craftsystem le 25/09/2007 02:34:21

fOxi

cette partit du code m'interresse

  if c = 1 then
    deletefile('C:\Windows\D-Krypt.wav');

mais je doute quel fonctionne

Car je me suis rendu compte
que pour pouvoir delete un fichier il fallait un:

mediaplayer1.close;

dans mon cas j'ai tester mais il bug

A pars sa je souhaiterais enregistrer le fichier décrypter mais pas toujours avec le meme nom mais avec des numeros:
D-Krypt01
D-Krypt02
D-Krypt03
...

si on peut m'aider

Commentaire de craftsystem le 25/09/2007 12:54:22

merci Japee
pour se bug

j'en ai trouver un autre pas mal non plus
si tu "ouvre un fichier son" puis un autre tu constateras
qu'il n'y a que le premier qui a été charger en lecture

jolie sa!!!

Commentaire de Caribensila le 25/09/2007 22:38:54

Salut,

Comme dit Flo, ce serait rigolo (mais pas simple, surtout en mp3).




Je surenchéris:
- pourquoi pas un message audio subliminal   o|O ?

:)))

Commentaire de cantador le 27/09/2007 11:57:22

@foxi :
Je suis d'accord sur le principe de citer l'auteur mais
Est-ce que DelphiFr est habilité à protéger ses droits ?
quelle est la version originale ?
pas simple tout çà..

Commentaire de cantador le 29/01/2008 21:17:20

@craftsystem :
La difficulté est de savoir si tel ou tel code est bien de son auteur.
Ce qui n'est pas évident à priori..car pour çà, il faudrait que l'original soit déposé quelque part..
C'était le sens de ma remarque;De la même manière qu'une mélodie
est enregistrée à la SACEM.

Cela ne nous prive pas d'avoir du respect.