Delphi Can
Basit Kriptoloji - 01 - Baskı Önizleme

+- Delphi Can (http://www.delphican.com)
+-- Forum: Delphi (http://www.delphican.com/forumdisplay.php?fid=3)
+--- Forum: Access violation (http://www.delphican.com/forumdisplay.php?fid=136)
+--- Konu Başlığı: Basit Kriptoloji - 01 (/showthread.php?tid=4155)

Sayfalar: 1 2


Basit Kriptoloji - 01 - Tuğrul HELVACI - 06-11-2019

Ekte bulunan plain.txt içinde şifreli bir metin bulunuyor.

Amacımız, bu metinde ne yazdığını deşifre etmek. İzlediğiniz yöntemleri, yazdığınız kod parçacıklarını da paylaşmalısınız elbette.

Cevap 50 puan değerinde.

İpucu : DELPHICAN

Başarılar


Basit Kriptoloji - 01 - Tuğrul HELVACI - 06-11-2019

Not: Dosya'yı diskinize kayıt edip; denemeleri o şekilde yapmanızı öneririm. Dosyayı tarayıcıların editöründe açıp, açılan içeriği kopyalayarak çalışmayın. Çeşitli unicode sorunları ile boğuşabilirsiniz.


Cvp: Basit Kriptoloji - 01 - Tuğrul HELVACI - 06-11-2019

Puan olarak zam mı yapsam acaba Big Grin


Basit Kriptoloji - 01 - frmman - 06-11-2019

Bakalım 50 puan gelecekmi Smile


procedure TForm1.Button6Click(Sender: TObject);
var
  AText,
  ACode     : String;

  pFirst,
  pLast,
  pCurr,
  pFirstCode,
  pLastCode,
  pCurrCode : PChar;
  AStream   : TStringStream;
  AReader   : TStreamReader;
begin
  AStream := TStringStream.Create();
  AReader := TStreamReader.Create('c:\temp\plain.txt');

  try
    AText := AReader.ReadToEnd;
    ACode := 'DELPHICAN';

    pFirst    := @AText[1];
    pLast     := @AText[AText.Length];
    pCurr     := pFirst;

    pFirstCode:= @ACode[1];
    pLastCode := @ACode[ACode.Length];
    pCurrCode := pFirstCode;

    while pCurr <= pLast do
    begin
      pCurr^ := Char( Ord(pCurr^) xor Ord(pCurrCode^) );

      Inc(pCurr);
      Inc(pCurrCode);

      if pCurrCode > pLastCode then
        pCurrCode := pFirstCode;
    end; // while pCurr <= pLast do
  finally
    if Assigned(AReader) then
      FreeAndNil(AReader);

    if Assigned(AStream) then
    begin
      AStream.WriteString(AText);
      AStream.SaveToFile('c:\temp\plain.txt');
      FreeAndNil(AStream);
    end;
  end;
end;




(06-11-2019, Saat: 16:27)Tuğrul HELVACI Adlı Kullanıcıdan Alıntı: Linkleri Görebilmeniz İçin Üye Olmanız Gerekiyor. Üye Olabilmek İçin Lütfen Buraya Tıklayınız.Puan olarak zam mı yapsam acaba Big Grin

Cevabı erkenmi paylaştım Smile @Tuğrul HELVACI  hocam. Ama yaparsanızda hayır demem Rolleyes

Uğraşan arkadaşlar olabilir belki diye onun için çözüm kodlarını mesajla birlikte paylaşmadım. İş çıkışı beyin jimnastiği oldu. Eve geçince çözüm yönteminide paylaşırım.

Yazdıktan sonra fark ettim aslında dolaylı yoldan çözüm yolunuda paylaşmış oldum. Çözüm yöntemi bulmacanın cevabının içinde Smile


Cvp: Basit Kriptoloji - 01 - Tuğrul HELVACI - 06-11-2019

(06-11-2019, Saat: 17:05)frmman Adlı Kullanıcıdan Alıntı: Linkleri Görebilmeniz İçin Üye Olmanız Gerekiyor. Üye Olabilmek İçin Lütfen Buraya Tıklayınız.Bakalım 50 puan gelecekmi Smile


procedure TForm1.Button6Click(Sender: TObject);
var
  AText,
  ACode     : String;

  pFirst,
  pLast,
  pCurr,
  pFirstCode,
  pLastCode,
  pCurrCode : PChar;
  AStream   : TStringStream;
  AReader   : TStreamReader;
begin
  AStream := TStringStream.Create();
  AReader := TStreamReader.Create('c:\temp\plain.txt');

  try
    AText := AReader.ReadToEnd;
    ACode := 'DELPHICAN';

    pFirst    := @AText[1];
    pLast     := @AText[AText.Length];
    pCurr     := pFirst;

    pFirstCode:= @ACode[1];
    pLastCode := @ACode[ACode.Length];
    pCurrCode := pFirstCode;

    while pCurr <= pLast do
    begin
      pCurr^ := Char( Ord(pCurr^) xor Ord(pCurrCode^) );

      Inc(pCurr);
      Inc(pCurrCode);

      if pCurrCode > pLastCode then
        pCurrCode := pFirstCode;
    end; // while pCurr <= pLast do
  finally
    if Assigned(AReader) then
      FreeAndNil(AReader);

    if Assigned(AStream) then
    begin
      AStream.WriteString(AText);
      AStream.SaveToFile('c:\temp\plain.txt');
      FreeAndNil(AStream);
    end;
  end;
end;




(06-11-2019, Saat: 16:27)Tuğrul HELVACI Adlı Kullanıcıdan Alıntı: Linkleri Görebilmeniz İçin Üye Olmanız Gerekiyor. Üye Olabilmek İçin Lütfen Buraya Tıklayınız.Puan olarak zam mı yapsam acaba Big Grin

Cevabı erkenmi paylaştım Smile @Tuğrul HELVACI  hocam. Ama yaparsanızda hayır demem Rolleyes

Uğraşan arkadaşlar olabilir belki diye onun için çözüm kodlarını mesajla birlikte paylaşmadım. İş çıkışı beyin jimnastiği oldu. Eve geçince  çözüm yönteminide paylaşırım.

Yazdıktan sonra fark ettim aslında dolaylı yoldan çözüm yolunuda paylaşmış oldum. Çözüm yöntemi bulmacanın cevabının içinde Smile

100 puan verdim Wink 

Evet, cevabı görünce çözen arkadaş gülümsesin diye bu şekilde yaptım  Smile


Basit Kriptoloji - 01 - esistem - 06-11-2019

Değişik bir şifreleme yöntemi olmuş hocam, fazla bakamadım ama xor'u güzel kullanmışsınız aklıma gelmezdi şahsen.


Basit Kriptoloji - 01 - adelphiforumz - 06-11-2019

@frmman hocam @Tuğrul HELVACI hocamın yazısından nasıl böyle bir yol izlediğini anladınız da bu yapıyı çözdünüz.
içerideki veri birçok yolla şifrelenmiş olabilir benim kaçırdığım kilit bir cümle yada kelimemi oldu acaba yazının içinde.


Cvp: Basit Kriptoloji - 01 - frmman - 06-11-2019

(06-11-2019, Saat: 19:03)adelphiforumz Adlı Kullanıcıdan Alıntı: Linkleri Görebilmeniz İçin Üye Olmanız Gerekiyor. Üye Olabilmek İçin Lütfen Buraya Tıklayınız.@frmman hocam @Tuğrul HELVACI  hocamın yazısından nasıl böyle bir yol izlediğini anladınız da bu yapıyı çözdünüz.
içerideki veri birçok yolla şifrelenmiş olabilir benim kaçırdığım kilit bir cümle yada kelimemi oldu acaba yazının içinde.

@adelphiforumz  şifre çözme biraz sezgisel birazda şans işi.

Alıntı:Not: Dosya'yı diskinize kayıt edip; denemeleri o şekilde yapmanızı öneririm. Dosyayı tarayıcıların editöründe açıp, açılan içeriği kopyalayarak çalışmayın. Çeşitli unicode sorunları ile boğuşabilirsiniz.

Uyarısı dosyayı hex editör ile açıp inceleme yapma konusunda bir fikir verdi. Hex editörde çeşitli paternler, bunların dağılımına göz gezdirdim. İpucu olarak metin verildiği söylendiği için harflerin dağılım oranlarına göre sesli ve sessiz harfleri kestirmeye yönelik tahminlerde bulundum.
Hex editördeki ilk 3 byte de  (0x34 0x37 0x23) ve DELPHICAN anahtarının hex karşılıkları (0x44 0x45 0x4c 0x50 0x48 0x49 0x43 0x41 0x4e) ile klasik lojik ve matematik işlemlerini kağıt üzerinde denedim.
Xor işlemine sıra gelince  sonucu çözülmüş metin "pro" olarak çıkınca bunu otomatiğe bağlayıp sonucu görmek istedim, ve sonuç başarılı çıktı.


Çözüm için aşağıdaki kod yapısını kullandım.

uses ioutils;
.....
.....
var
 Form1: TForm1;
 dosya:Tbytes;
 const key:array[1..9] of byte =($44, $45, $4c, $50, $48, $49, $43, $41, $4e);

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
 i: Integer;
 s:string;
 a:byte;

begin
   s:='';
   memo1.Clear;

   for i := 0 to Length(dosya)-1 do
   begin
        a := (i mod 9) + 1;
        s:= s + char(dosya[i] xor key[a]);
   end;

   memo1.Lines.Add(s);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 dosya:= Tfile.readAllbytes(ExtractFilePath(Application.ExeName)+'plain.txt');
end;



Cvp: Basit Kriptoloji - 01 - Tuğrul HELVACI - 07-11-2019

(06-11-2019, Saat: 19:32)frmman Adlı Kullanıcıdan Alıntı: Linkleri Görebilmeniz İçin Üye Olmanız Gerekiyor. Üye Olabilmek İçin Lütfen Buraya Tıklayınız.
(06-11-2019, Saat: 19:03)adelphiforumz Adlı Kullanıcıdan Alıntı: Linkleri Görebilmeniz İçin Üye Olmanız Gerekiyor. Üye Olabilmek İçin Lütfen Buraya Tıklayınız.@frmman hocam @Tuğrul HELVACI  hocamın yazısından nasıl böyle bir yol izlediğini anladınız da bu yapıyı çözdünüz.
içerideki veri birçok yolla şifrelenmiş olabilir benim kaçırdığım kilit bir cümle yada kelimemi oldu acaba yazının içinde.

@adelphiforumz  şifre çözme biraz sezgisel birazda şans işi.

Alıntı:Not: Dosya'yı diskinize kayıt edip; denemeleri o şekilde yapmanızı öneririm. Dosyayı tarayıcıların editöründe açıp, açılan içeriği kopyalayarak çalışmayın. Çeşitli unicode sorunları ile boğuşabilirsiniz.

Uyarısı dosyayı hex editör ile açıp inceleme yapma konusunda bir fikir verdi. Hex editörde çeşitli paternler, bunların dağılımına göz gezdirdim. İpucu olarak metin verildiği söylendiği için harflerin dağılım oranlarına göre sesli ve sessiz harfleri kestirmeye yönelik tahminlerde bulundum.
Hex editördeki ilk 3 byte de  (0x34 0x37 0x23) ve DELPHICAN anahtarının hex karşılıkları (0x44 0x45 0x4c 0x50 0x48 0x49 0x43 0x41 0x4e) ile klasik lojik ve matematik işlemlerini kağıt üzerinde denedim.
Xor işlemine sıra gelince  sonucu çözülmüş metin "pro" olarak çıkınca bunu otomatiğe bağlayıp sonucu görmek istedim, ve sonuç başarılı çıktı.


Çözüm için aşağıdaki kod yapısını kullandım.

uses ioutils;
.....
.....
var
 Form1: TForm1;
 dosya:Tbytes;
 const key:array[1..9] of byte =($44, $45, $4c, $50, $48, $49, $43, $41, $4e);

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
 i: Integer;
 s:string;
 a:byte;

begin
   s:='';
   memo1.Clear;

   for i := 0 to Length(dosya)-1 do
   begin
        a := (i mod 9) + 1;
        s:= s + char(dosya[i] xor key[a]);
   end;

   memo1.Lines.Add(s);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 dosya:= Tfile.readAllbytes(ExtractFilePath(Application.ExeName)+'plain.txt');
end;

Tebrik ederim güzel kardeşim. Ellerine aklına sağlık.


Basit Kriptoloji - 01 - Tuğrul HELVACI - 07-11-2019

Bu konu bir seri olabilir mi acaba, ne dersiniz arkadaşlar ;-) Kripto 2,3,4...de sizlerden gelir mi ?