Correction png

This is the MD5 method of taking the correction +

function MD5FileTextPng(filename: AnsiString): AnsiString;
var
  buf: array[0..MAX_PATH - 1] of Char;
  path: AnsiString;
  stream: TFileStream;
  destStream: TMemoryStream;
  destfile, tmpText: string;
  I, len: Integer;
  endbuf: array[0..3] of Byte;
  firstChar: Byte;
  strstream: TStringStream;
const
  pngEndBuf: array[0..3] of Byte = ($AE, $42, $60, $82);
begin
  GetTempPath(Length(buf), @buf[0]);
  path := AnsiString(string(buf));
  tmpText := ExtractFileName(filename);
  tmpText := Copy(tmpText, 1, Length(tmpText) - 4);

  strstream := TStringStream.Create(tmpText, TEncoding.UTF8);
  strstream.Position := 0;

  stream := TFileStream.Create(filename, fmOpenRead);
  try
    destStream := TMemoryStream.Create;
    try
      stream.Position := 0;
      for I := 0 to stream.Size - 3 do
        begin
          stream.Read(firstChar, 1);
          if firstChar <> $AE then
            Continue;
          stream.Position := stream.Position - 1;
          stream.Read(endbuf[0], 4);
          if CompareMem(@endbuf[0], @pngEndBuf[0], 4) then
          begin
            len := stream.Position;
            Break;
          end;
        end;

      stream.Position := 0;
      destStream.CopyFrom(stream, len);

      destfile := path + '\' + GetRamdomText(10);
      if FileExists(destfile) then
        DeleteFile(destfile);

      destStream.CopyFrom(strstream, strstream.Size);
      destStream.SaveToFile(destfile);
      strstream.Free;

      Result := MD5F(destfile);
    finally
      destStream.Free;
    end;
  finally
    stream.Free;
  end;

  if FileExists(destfile) then
    DeleteFile(destfile);
end;

 

This is PNG batch correction code, pas + dfm

uFixpng.pas
unit uFixpng;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, uMD5, Vcl.StdCtrls, Vcl.FileCtrl,
  System.IOUtils, System.Types, Vcl.Samples.Gauges;

type
  TForm2 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Label1: TLabel;
    Gauge1: TGauge;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Edit1DblClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

function FixPng(filename: AnsiString; destFileName: string): Boolean;
var
  stream: TFileStream;
  destStream: TMemoryStream;
  I, len: Integer;
  endbuf: array[0..3] of Byte;
  firstChar: Byte;
const
  pngEndBuf: array[0..3] of Byte = ($AE, $42, $60, $82);
begin
  stream := TFileStream.Create(filename, fmOpenRead);
  try
    destStream := TMemoryStream.Create;
    try
      stream.Position := 0;
      for I := 0 to stream.Size - 3 do
        begin
          stream.Read(firstChar, 1);
          if firstChar <> $AE then Continue;
          stream.Position := stream.Position - 1;
          stream.Read(endbuf[0], 4);
          if CompareMem(@endbuf[0], @pngEndBuf[0], 4) then
          begin
            len := stream.Position;
            Break;
          end;
        end;

      stream.Position := 0;
      destStream.CopyFrom(stream, len);
      destStream.SaveToFile(destFileName);
    finally
      destStream.Free;
    end;
  finally
    stream.Free;
  end;

  Result := True;
end;

procedure TForm2.Button1Click(Sender: TObject);
var
  files: TStringDynArray;
  path, destPath, destFile: string;
  I: Integer;
begin
  TButton(Sender).Enabled := False;
  Gauge1.Visible := True;
  try
    path := Trim(Edit1.Text);
    if not TDirectory.Exists(path) then Exit;

    files := TDirectory.GetFiles(path, '*.png');

    destPath := TPath.Combine(path, 'Fix-' + FormatDateTime('hhnnss', Now));

    if not TDirectory.Exists(destPath) then
      TDirectory.CreateDirectory(destPath);

    Gauge1.Progress := 0;
    Gauge1.MinValue := 0;
    Gauge1.MaxValue := Length(files);
    for I := Low(files) to High(files) do
    begin
      destFile := TPath.Combine(destPath, ExtractFileName(files[I]));
      FixPng(files[I], destFile);
      Gauge1.Progress := Gauge1.Progress + 1;
      Application.ProcessMessages;
    end;
  finally
    TButton(Sender).Enabled := True;
    Gauge1.Visible := False;
  end;
end;

procedure TForm2.Edit1DblClick(Sender: TObject);
var
  path: string;
begin
  SelectDirectory('选择png文件夹', '', path);
  Edit1.Text := path;
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  Position := poScreenCenter;
end;

end.

 

uFixpng.dfm

object Form2: TForm2
  Left = 0
  Top = 0
  Caption = #20462#27491'png'
  ClientHeight = 101
  ClientWidth = 543
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 22
    Top = 21
    Width = 68
    Height = 13
    Caption = 'PNG'#22270#29255#36335#24452
  end
  object Gauge1: TGauge
    Left = 0
    Top = 96
    Width = 543
    Height = 5
    Align = alBottom
    Color = clNavy
    ParentColor = False
    Progress = 0
    ShowText = False
    Visible = False
  end
  object Edit1: TEdit
    Left = 22
    Top = 43
    Width = 401
    Height = 21
    TabOrder = 0
    OnDblClick = Edit1DblClick
  end
  object Button1: TButton
    Left = 445
    Top = 41
    Width = 75
    Height = 25
    Caption = #25209#37327#22788#29702
    TabOrder = 1
    OnClick = Button1Click
  end
end

 

Guess you like

Origin www.cnblogs.com/onlyou13/p/11764824.html