Ficzery wersji alpha 1:
- pobieranie wyników losowań z podanego zakresu dat ze strony http://www.lotto.pl/.
- ładowanie/zapis wyników losowań z/do pliku (uzupełnia tylko to czego jeszcze w pliku nie ma).
- wyszukiwanie sześciu najczęściej i najrzadziej wypadających liczb.
- wyszukiwanie jakie liczby nie wypadły przez x losowań.
Program pisany w Lazarusie 1.6 (FPC 3.0.0).
Program pisałem na szybko byle by działał.
- Mam wrażenie, że pobieranie danych ze strony można przyspieszyć.
- Trzeba by zlikwidować magic numbers.
A teraz kod:
Unit Utils
unit Utils;
{$mode objfpc}{$H+}
{---- interface ---------------------------------------------------------------}
interface
uses
Classes, SysUtils, Dialogs, httpsend;
{---- types -------------------------------------------------------------------}
type
TNumbersArray = array[0..5] of Byte;
type
TBet = record
Number : TNumbersArray;
Date : TDateTime;
end;
type
TBetArray = array of TBet;
type
TDataRange = record
DateFrom : TDateTime;
DateTo : TDateTime;
end;
type
TFileHeader = record
NumberOfBets : Integer;
DataRange : TDataRange;
end;
type
TNumber = record
Number : Byte;
Count : Word;
end;
type
TNumberArray = array [1..49] of TNumber;
{---- constants ---------------------------------------------------------------}
const
FILENAME = 'data.dat';
{---- variables ---------------------------------------------------------------}
var
Bets : TBetArray;
CurrentRange : TDataRange;
{---- declarations of procedures/functions ------------------------------------}
function GetData(ADate : string) : TStringList;
procedure GetNumber(AData : TStringList; var ANumbers : TNumbersArray);
procedure BubbleSort(var ANumbers : TNumbersArray); overload;
procedure BubbleSort(var ANumbers : TBetArray); overload;
procedure BubbleSort(var ANumbers : TNumberArray); overload;
{---- implementation ----------------------------------------------------------}
implementation
{---- hidden procedures/functions ---------------------------------------------}
procedure Swap(var AValue1, AValue2 : Byte); overload;
var
Tmp : Integer;
begin
Tmp := AValue1;
AValue1 := AValue2;
AValue2 := Tmp;
end;
procedure Swap(var AValue1, AValue2 : TBet); overload;
var
Tmp : TBet;
begin
Tmp := AValue1;
AValue1 := AValue2;
AValue2 := Tmp;
end;
procedure Swap(var AValue1, AValue2 : TNumber); overload;
var
Tmp : TNumber;
begin
Tmp := AValue1;
AValue1 := AValue2;
AValue2 := Tmp;
end;
{---- public procedures/functions ---------------------------------------------}
function GetData(ADate : string) : TStringList;
var
HTTP: THTTPSend;
begin
result := TStringList.create;
result.Clear;
HTTP := THTTPSend.Create;
try
if HTTP.HTTPMethod('GET', 'http://www.lotto.pl/lotto/wyniki-i-wygrane?data_losowania[date]='+ADate+'&op=') then
result.LoadFromStream(Http.Document);
finally
HTTP.Free;
end;
end;
procedure GetNumber(AData : TStringList; var ANumbers : TNumbersArray);
var
SearchText : string;
Number : string;
Raw : LongInt;
i : Byte;
begin
SearchText := Copy(AData.Text, Pos('Wyniki wyszukiwania', AData.Text), 1200);
if Pos('Wyniki wyszukiwania', SearchText) <> 0 then
begin
for i := 1 to 6 do
begin
Number := Copy(SearchText, Pos('yellowball liczba' + IntToStr(i), SearchText) + 20, 2);
if tryStrToInt(Number, Raw) then
ANumbers[i-1] := Raw
else
begin
Number := Copy(Number, 1, 1);
ANumbers[i-1] := StrToInt(Number);
end;
end
end
else
for i := 0 to 5 do
ANumbers[i] := 0;
end;
procedure BubbleSort(var ANumbers : TNumbersArray); overload;
var
i,j : Word;
begin
for i := Low(ANumbers) to High(ANumbers) - 1 do
for j := Low(ANumbers) to High(ANumbers) - 1 do
begin
if Anumbers[j] > ANumbers[j+1] then
Swap(ANumbers[j], ANumbers[j+1]);
end;
end;
procedure BubbleSort(var ANumbers : TBetArray); overload;
var
i,j : Word;
begin
for i := Low(ANumbers) to High(ANumbers) - 1 do
for j := Low(ANumbers) to High(ANumbers) - 1 do
begin
if Anumbers[j].Date > ANumbers[j+1].Date then
Swap(ANumbers[j], ANumbers[j+1]);
end;
end;
procedure BubbleSort(var ANumbers : TNumberArray); overload;
var
i,j : Word;
begin
for i := Low(ANumbers) to High(ANumbers) - 1 do
for j := Low(ANumbers) to High(ANumbers) - 1 do
begin
if Anumbers[j].Count > ANumbers[j+1].Count then
Swap(ANumbers[j], ANumbers[j+1]);
end;
end;
{------------------------------------------------------------------------------}
end.
Unit Main
unit main_unit;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Grids,
ComCtrls, StdCtrls, ExtDlgs, DateUtils, Utils;
type
{ TForm1 }
TForm1 = class(TForm)
btnAbout: TButton;
btnClose: TButton;
btnDownloadData: TButton;
btnSelectDateFrom: TButton;
btnSelectDateTo: TButton;
btnLoadFromFile: TButton;
btnSaveToFile: TButton;
btnSearchFrequency: TButton;
btnSearch: TButton;
CalendarDialog1: TCalendarDialog;
eGames: TEdit;
eFound: TEdit;
eRareNumbers: TEdit;
eCommonNumbers: TEdit;
eFromDate: TEdit;
eToDate: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
PageControl1: TPageControl;
ProgressBar1: TProgressBar;
StringGrid1: TStringGrid;
TabSheet1: TTabSheet;
TabSheet2: TTabSheet;
TabSheet3: TTabSheet;
procedure btnCloseClick(Sender: TObject);
procedure btnDownloadDataClick(Sender: TObject);
procedure btnLoadFromFileClick(Sender: TObject);
procedure btnSaveToFileClick(Sender: TObject);
procedure btnSearchClick(Sender: TObject);
procedure btnSearchFrequencyClick(Sender: TObject);
procedure btnSelectDateFromClick(Sender: TObject);
procedure btnSelectDateToClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ private declarations }
procedure DownloadData();
procedure UpdateGrid();
procedure ShowProgress();
procedure HideProgress();
procedure LoadFromFile();
procedure SaveToFile();
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.DownloadData();
var
Days : Integer;
Date : TDateTime;
i : Integer;
Bet : TBet;
begin
CurrentRange.DateFrom := StrToDate(eFromDate.Text);
CurrentRange.DateTo := StrToDate(eToDate.Text);
Days := DaysBetween(StrToDate(eFromDate.Text), StrToDate(eToDate.Text));
ProgressBar1.Max := Days;
ProgressBar1.Min := 0;
ProgressBar1.Position := 0;
Date := StrToDate(eFromDate.Text);
SetLength(Bets, 0);
for i := 0 to Days do
begin
Application.ProcessMessages();
GetNumber(GetData(DateToStr(Date)), Bet.Number);
Sleep(1);
Bet.Date := Date;
if Bet.Number[0] <> 0 then
begin
BubbleSort(Bet.Number);
SetLength(Bets, Length(Bets) + 1);
Bets[Length(Bets) - 1] := Bet;
end;
ProgressBar1.Position := i;
Date := Date + 1;
end;
end;
procedure TForm1.UpdateGrid();
var
i, j : Integer;
begin
ProgressBar1.Max := Length(Bets) + 1;
ProgressBar1.Min := 0;
ProgressBar1.Position := 0;
StringGrid1.RowCount := Length(Bets) + 1;
for i := 1 to Length(Bets) do
begin
Application.ProcessMessages();
for j := 0 to 5 do
StringGrid1.Cells[j + 1,i] := IntToStr(Bets[i-1].Number[j]);
StringGrid1.Cells[0,i] := DateToStr(Bets[i - 1].Date);
ProgressBar1.Position := i;
end;
end;
procedure TForm1.ShowProgress();
begin
eFromDate.Enabled := False;
eToDate.Enabled := False;
btnDownloadData.Enabled := False;
btnSelectDateFrom.Enabled := False;
btnSelectDateTo.Enabled := False;
btnLoadFromFile.Enabled := False;
btnSaveToFile.Enabled := False;
btnSearchFrequency.Enabled := False;
eGames.Enabled := False;
btnSearch.Enabled := False;
btnAbout.Enabled := False;
btnClose.Enabled := False;
ProgressBar1.Visible := True;
end;
procedure TForm1.HideProgress();
begin
eFromDate.Enabled := True;
eToDate.Enabled := True;
btnDownloadData.Enabled := True;
btnSelectDateFrom.Enabled := True;
btnSelectDateTo.Enabled := True;
btnLoadFromFile.Enabled := True;
btnSaveToFile.Enabled := True;
btnSearchFrequency.Enabled := True;
eGames.Enabled := True;
btnSearch.Enabled := True;
btnAbout.Enabled := True;
btnClose.Enabled := True;
ProgressBar1.Visible := False;
end;
procedure TForm1.LoadFromFile();
var
DataFile : TFileStream;
FileHeader : TFileHeader;
i : Integer;
Bet : TBet;
begin
ProgressBar1.Min := 0;
if FileExists(FILENAME)then
begin
DataFile := TFileStream.Create(FILENAME, fmOpenRead);
try
DataFile.ReadBuffer(FileHeader, SizeOf(FileHeader));
DataFile.Seek(soFromBeginning, SizeOf(FileHeader));
ProgressBar1.Max := FileHeader.NumberOfBets -1;
SetLength(Bets, FileHeader.NumberOfBets);
for i := 0 to FileHeader.NumberOfBets - 1 do
begin
DataFile.ReadBuffer(Bet, SizeOf(Bet));
Bets[i] := Bet;
ProgressBar1.Position := i;
end;
finally
DataFile.free();
end;
end
end;
procedure TForm1.SaveToFile();
var
DataFile : TFileStream;
FileHeader : TFileHeader;
Bet : TBet;
DataRange : TDataRange;
BetsFromFile,
BetsToSave : TBetArray;
Save : Boolean;
i,j : Integer;
begin
ProgressBar1.Min := 0;
if FileExists(FILENAME)then
begin
DataFile := TFileStream.Create(FILENAME, fmOpenRead);
try
DataFile.ReadBuffer(FileHeader, SizeOf(FileHeader));
DataFile.Seek(soFromBeginning, SizeOf(FileHeader));
SetLength(BetsFromFile, FileHeader.NumberOfBets);
ProgressBar1.Max := FileHeader.NumberOfBets - 1;
for i := 0 to FileHeader.NumberOfBets - 1 do
begin
DataFile.ReadBuffer(Bet, SizeOf(Bet));
BetsFromFile[i] := Bet;
ProgressBar1.Position := i;
end;
finally
DataFile.free();
end;
ProgressBar1.Max := Length(Bets) - 1;
SetLength(BetsToSave, 0);
Save := True;
for i := 0 to Length(Bets) - 1 do
begin
for j := 0 to Length(BetsFromFile) - 1 do
if Bets[i].Date = BetsFromFile[j].Date then
begin
Save := False;
Break
end;
if Save then
begin
SetLength(BetsToSave, Length(BetsToSave) + 1);
BetsToSave[Length(BetsToSave) - 1] := Bets[i];
end;
Save := True;
ProgressBar1.Position := i;
end;
ProgressBar1.Max := Length(BetsFromFile) - 1;
for i := 0 to Length(BetsFromFile) - 1 do
begin
SetLength(BetsToSave, Length(BetsToSave) + 1);
BetsToSave[Length(BetsToSave) - 1] := BetsFromFile[i];
ProgressBar1.Position := i;
end;
BubbleSort(BetsToSave);
if CurrentRange.DateFrom < FileHeader.DataRange.DateFrom then
DataRange.DateFrom := CurrentRange.DateFrom
else
DataRange.DateFrom := FileHeader.DataRange.DateFrom;
if CurrentRange.DateTo > FileHeader.DataRange.DateTo then
DataRange.DateTo := CurrentRange.DateTo
else
DataRange.DateTo := FileHeader.DataRange.DateTo;
FileHeader.DataRange := DataRange;
FileHeader.NumberOfBets := Length(BetsToSave);
ProgressBar1.Max := Length(BetsToSave) - 1;
DataFile := TFileStream.Create(FILENAME, fmCreate);
try
DataFile.WriteBuffer(FileHeader, SizeOf(FileHeader));
for i := 0 to FileHeader.NumberOfBets - 1 do
begin
DataFile.WriteBuffer(BetsToSave[i], SizeOf(Bet));
ProgressBar1.Position := i;
end;
finally
DataFile.free();
end;
end
else
begin
FileHeader.DataRange := CurrentRange;
FileHeader.NumberOfBets := Length(Bets);
ProgressBar1.Max := Length(Bets) - 1;
DataFile := TFileStream.Create(FILENAME, fmCreate);
try
DataFile.WriteBuffer(FileHeader, SizeOf(FileHeader));
for i := 0 to FileHeader.NumberOfBets - 1 do
begin
DataFile.WriteBuffer(Bets[i], SizeOf(Bet));
ProgressBar1.Position := i;
end;
finally
DataFile.free();
end;
end;
end;
procedure TForm1.btnCloseClick(Sender: TObject);
begin
Form1.Close;
end;
procedure TForm1.btnDownloadDataClick(Sender: TObject);
begin
ShowProgress();
DownloadData();
UpdateGrid();
HideProgress();
end;
procedure TForm1.btnLoadFromFileClick(Sender: TObject);
begin
ShowProgress();
LoadFromFile();
UpdateGrid();
HideProgress();
end;
procedure TForm1.btnSaveToFileClick(Sender: TObject);
begin
ShowProgress;
SaveToFile();
UpdateGrid();
HideProgress;
end;
procedure TForm1.btnSearchClick(Sender: TObject);
var
i, j : Integer;
Numbers : TNumberArray;
begin
ShowProgress();
eFound.Text := '';
for i := 1 to 49 do
begin
Numbers[i].Number := i;
Numbers[i].Count := 0;
end;
ProgressBar1.Max := StrToInt(eGames.Text);
ProgressBar1.Min := 0;
for i := Length(Bets) - 1 - StrToInt(eGames.Text) to Length(Bets) - 1 do
begin
for j := 0 to 5 do
Inc(Numbers[Bets[i].Number[j]].Count);
ProgressBar1.Position := ProgressBar1.Position + 1;
end;
for i := 1 to 49 do
if Numbers[i].Count = 0 then
eFound.Text := eFound.Text + IntToStr(Numbers[i].Number) + ' ';
HideProgress();
end;
procedure TForm1.btnSearchFrequencyClick(Sender: TObject);
var
Numbers : TNumberArray;
i, j : Word;
begin
ShowProgress();
eCommonNumbers.Text := '';
eRareNumbers.Text := '';
for i := 1 to 49 do
begin
Numbers[i].Number := i;
Numbers[i].Count := 0;
end;
ProgressBar1.Max := Length(Bets) - 1;
ProgressBar1.Min := 0;
for i := 0 to Length(Bets) - 1 do
begin
for j := 0 to 5 do
Inc(Numbers[Bets[i].Number[j]].Count);
ProgressBar1.Position := i;
end;
BubbleSort(Numbers);
for i := 49 downto 44 do
eCommonNumbers.Text := eCommonNumbers.Text + IntToStr(Numbers[i].Number) + ' ';
for i := 1 to 6 do
eRareNumbers.Text := eRareNumbers.Text + IntToStr(Numbers[i].Number) + ' ';
HideProgress();
end;
procedure TForm1.btnSelectDateFromClick(Sender: TObject);
begin
if CalendarDialog1.execute then
eFromDate.text := DateToStr(CalendarDialog1.Date);
end;
procedure TForm1.btnSelectDateToClick(Sender: TObject);
begin
if CalendarDialog1.execute then
eToDate.text := DateToStr(CalendarDialog1.Date);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
SetLength(Bets, 0);
eFromDate.Text := DateToStr(Now);
eToDate.Text := DateToStr(Now);
LoadFromFile();
UpdateGrid();
end;
end.