I have just repaired 2 problems ( 1074,1097 ) for you :

   - 1074
           +  when s='', you call s[1] = '-' --> crash;
           +  Use {$R+} in the begining of source code to
solved other error.

   - 1097
           + The initialize value of Max is 1, you use 0 ---
--> wrong answer.
           + Your algo is too slow, you must change it.

@ Good luck !!!

PS : Can you tell me the way to solve 1018 ?
     Mail to : dinhhongminh@yahoo.com

Var Map         : Array[0..100,1..2] of Longint;
    Apples      : Array[1..100,1..2] of Longint;
    Num         : Array[1..100] of Byte;
    NumAll      : Array[1..100] of Byte;
    Del         : Array[0..100,0..100] of Longint;
    Tree        : Array[1..100,1..100] of Integer;
    N,Q         : Byte;
    Total       : Longint;

Procedure Init;
Var i,j,k : Integer;
    l     : Integer;
    D     : Array[1..100] of Integer;
    B     : Array[1..100] of Boolean;
    H,T   : Integer;
Begin
  Assign(Input,'1018.txt'); Reset(Input);
  Readln(N,Q);
  For i := 1 to N-1 do
    Begin
      Readln(j,k,l);
      Tree[j,k] := l;
      Tree[k,j] := l;
      Total := Total+l;
    End;
  Fillchar(B,Sizeof(B),True);
  D[1] := 1; H := 1; T := 1;
  B[1] := False;
  Repeat
    For i := 1 to N do
      If B[i] then
        If Tree[D[H],i]<>0 then
          Begin
            Inc(Num[D[H]]);
            Map[D[H],Num[D[H]]] := i;
            Apples[D[H],Num[D[H]]] := Tree[D[H],i];
            Inc(T);
            D[T] := i;
            B[i] := False;
          End;
    Inc(H);
  Until H>T
End;

Function Pass(X : Byte) : Boolean;
Var i,j : Integer;
Begin
  Pass := False;
  If Num[X]=0 then Exit;
  For i := 1 to Num[X] do
    If Num[Map[X,i]]<>0 then exit;
  Pass := True;
End;

Procedure Main;
Var i,j,k,l     : Longint;
    No_Change   : Boolean;
    C           : Array[0..2] of Longint;
    Root        : Integer;
    T1,T2       : Integer;
Begin
  For i := 0 to N do
    For j := 1 to N do
      Del[i,j] := Maxlongint;
  Repeat
    No_Change := True;
    For i := 1 to N do
      If Pass(i) then
        Begin
          No_Change := False;
          Root := i;
          C[0] := 0;
          T1 := Map[i,1]; T2 := Map[i,2];
          For j := 1 to N do
            For k := 0 to j do
              If Del[T1,k]<Maxlongint then
                Begin
                  l := j-k;
                  If Del[T2,l]<Maxlongint then
                    If Del[T1,k]+Del[T2,l]<Del[i,j] then
                      Del[i,j] := Del[T1,k]+Del[T2,l]
                End;
          For j := 0 to N-(NumAll[T1]+1) do
            If Del[T2,j]<Maxlongint then
              If Apples[i,1]+Del[T1,NumAll[T1]]+Del[T2,j]
<Del[i,NumAll[T1]+1+j] then
                Del[i,NumAll[T1]+1+j] := Apples[i,1]+Del
[T1,NumAll[T1]]+Del[T2,j];
          If Num[i]=2 then
            Begin
              For j := 0 to N-(NumAll[T2]+1) do
                If Del[T1,j]<Maxlongint then
                  If Apples[i,2]+Del[T2,NumAll[T2]]+Del
[T1,j]<Del[i,NumAll[T2]+1+j] then
                    Del[i,NumAll[T2]+1+j] := Apples[i,2]+Del
[T2,NumAll[T2]]+Del[T1,j];
              If Apples[i,1]+Apples[i,2]+Del[T1,NumAll[T1]]
+Del[T2,NumAll[T2]]<
                 Del[i,NumAll[T1]+NumAll[T2]+2] then
                 Del[i,NumAll[T1]+NumAll[T2]+2] :=
                 Apples[i,1]+Apples[i,2]+Del[T1,NumAll[T1]]
+Del[T2,NumAll[T2]]
            End;
          NumAll[i] := Num[i];
          For j := 1 to Num[i] do
            Inc(NumAll[i],Numall[Map[i,j]]);
          Num[i] := 0;
        End;
  Until No_Change;
  Writeln(Total-Del[Root,N-1-Q]);
End;

Begin
  Init;
  Main;
End.

> Var Map         : Array[0..100,1..2] of Longint;
>     Apples      : Array[1..100,1..2] of Longint;
>     Num         : Array[1..100] of Byte;
>     NumAll      : Array[1..100] of Byte;
>     Del         : Array[0..100,0..100] of Longint;
>     Tree        : Array[1..100,1..100] of Integer;
>     N,Q         : Byte;
>     Total       : Longint;
>
> Procedure Init;
> Var i,j,k : Integer;
>     l     : Integer;
>     D     : Array[1..100] of Integer;
>     B     : Array[1..100] of Boolean;
>     H,T   : Integer;
> Begin
>   Assign(Input,'1018.txt'); Reset(Input);
>   Readln(N,Q);
>   For i := 1 to N-1 do
>     Begin
>       Readln(j,k,l);
>       Tree[j,k] := l;
>       Tree[k,j] := l;
>       Total := Total+l;
>     End;
>   Fillchar(B,Sizeof(B),True);
>   D[1] := 1; H := 1; T := 1;
>   B[1] := False;
>   Repeat
>     For i := 1 to N do
>       If B[i] then
>         If Tree[D[H],i]<>0 then
>           Begin
>             Inc(Num[D[H]]);
>             Map[D[H],Num[D[H]]] := i;
>             Apples[D[H],Num[D[H]]] := Tree[D[H],i];
>             Inc(T);
>             D[T] := i;
>             B[i] := False;
>           End;
>     Inc(H);
>   Until H>T
> End;
>
> Function Pass(X : Byte) : Boolean;
> Var i,j : Integer;
> Begin
>   Pass := False;
>   If Num[X]=0 then Exit;
>   For i := 1 to Num[X] do
>     If Num[Map[X,i]]<>0 then exit;
>   Pass := True;
> End;
>
> Procedure Main;
> Var i,j,k,l     : Longint;
>     No_Change   : Boolean;
>     C           : Array[0..2] of Longint;
>     Root        : Integer;
>     T1,T2       : Integer;
> Begin
>   For i := 0 to N do
>     For j := 1 to N do
>       Del[i,j] := Maxlongint;
>   Repeat
>     No_Change := True;
>     For i := 1 to N do
>       If Pass(i) then
>         Begin
>           No_Change := False;
>           Root := i;
>           C[0] := 0;
>           T1 := Map[i,1]; T2 := Map[i,2];
>           For j := 1 to N do
>             For k := 0 to j do
>               If Del[T1,k]<Maxlongint then
>                 Begin
>                   l := j-k;
>                   If Del[T2,l]<Maxlongint then
>                     If Del[T1,k]+Del[T2,l]<Del[i,j] then
>                       Del[i,j] := Del[T1,k]+Del[T2,l]
>                 End;
>           For j := 0 to N-(NumAll[T1]+1) do
>             If Del[T2,j]<Maxlongint then
>               If Apples[i,1]+Del[T1,NumAll[T1]]+Del[T2,j]
> <Del[i,NumAll[T1]+1+j] then
>                 Del[i,NumAll[T1]+1+j] := Apples[i,1]+Del
> [T1,NumAll[T1]]+Del[T2,j];
>           If Num[i]=2 then
>             Begin
>               For j := 0 to N-(NumAll[T2]+1) do
>                 If Del[T1,j]<Maxlongint then
>                   If Apples[i,2]+Del[T2,NumAll[T2]]+Del
> [T1,j]<Del[i,NumAll[T2]+1+j] then
>                     Del[i,NumAll[T2]+1+j] := Apples[i,2]
+Del
> [T2,NumAll[T2]]+Del[T1,j];
>               If Apples[i,1]+Apples[i,2]+Del[T1,NumAll
[T1]]
> +Del[T2,NumAll[T2]]<
>                  Del[i,NumAll[T1]+NumAll[T2]+2] then
>                  Del[i,NumAll[T1]+NumAll[T2]+2] :=
>                  Apples[i,1]+Apples[i,2]+Del[T1,NumAll
[T1]]
> +Del[T2,NumAll[T2]]
>             End;
>           NumAll[i] := Num[i];
>           For j := 1 to Num[i] do
>             Inc(NumAll[i],Numall[Map[i,j]]);
>           Num[i] := 0;
>         End;
>   Until No_Change;
>   Writeln(Total-Del[Root,N-1-Q]);
> End;
>
> Begin
>   Init;
>   Main;
> End.